From gitlab at gitlab.haskell.org Wed Feb 1 01:46:48 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 31 Jan 2023 20:46:48 -0500 Subject: [Git][ghc/ghc][master] Bump transformers submodule to 0.6.0.6 Message-ID: <63d9c488907e_2a4f55fdc112765a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - 1 changed file: - libraries/transformers Changes: ===================================== libraries/transformers ===================================== @@ -1 +1 @@ -Subproject commit 2745db6c374c7e830a0f8fdeb8cc39bd8f054f36 +Subproject commit ceff1dcd7893f7ab4abb6e66bcd248abd86c8886 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/22089f693cf6e662a58a7011adb94d7f768ad2d7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/22089f693cf6e662a58a7011adb94d7f768ad2d7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 1 01:47:27 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 31 Jan 2023 20:47:27 -0500 Subject: [Git][ghc/ghc][master] compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Message-ID: <63d9c4af2bb8b_2a4f54d6c1132643@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 5 changed files: - compiler/GHC/Wasm/ControlFlow/FromCmm.hs - + testsuite/tests/cmm/should_run/T22871.hs - + testsuite/tests/cmm/should_run/T22871.stdout - + testsuite/tests/cmm/should_run/T22871_cmm.cmm - testsuite/tests/cmm/should_run/all.T Changes: ===================================== compiler/GHC/Wasm/ControlFlow/FromCmm.hs ===================================== @@ -75,7 +75,7 @@ flowLeaving platform b = let (offset, target_labels) = switchTargetsToTable targets (lo, hi) = switchTargetsRange targets default_label = switchTargetsDefault targets - scrutinee = smartPlus platform e offset + scrutinee = smartExtend platform $ smartPlus platform e offset range = inclusiveInterval (lo+toInteger offset) (hi+toInteger offset) in Switch scrutinee range target_labels default_label CmmCall { cml_cont = Nothing, cml_target = e } -> TailCall e @@ -314,6 +314,14 @@ structuredControl platform txExpr txBlock g = nodeBody :: CmmBlock -> CmmActions nodeBody (BlockCC _first middle _last) = middle +-- | A CmmSwitch scrutinee may have any width, but a br_table operand +-- must be exactly word sized, hence the extension here. (#22871) +smartExtend :: Platform -> CmmExpr -> CmmExpr +smartExtend p e | w0 == w1 = e + | otherwise = CmmMachOp (MO_UU_Conv w0 w1) [e] + where + w0 = cmmExprWidth p e + w1 = wordWidth p smartPlus :: Platform -> CmmExpr -> Int -> CmmExpr smartPlus _ e 0 = e ===================================== testsuite/tests/cmm/should_run/T22871.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnliftedFFITypes #-} + +import Data.Foldable +import GHC.Exts +import GHC.Int + +foreign import prim "foo" foo :: Int64# -> Int64# + +main :: IO () +main = for_ [0, 42, 114514] $ \(I64# x#) -> print $ I64# (foo x#) ===================================== testsuite/tests/cmm/should_run/T22871.stdout ===================================== @@ -0,0 +1,3 @@ +233 +84 +1919810 ===================================== testsuite/tests/cmm/should_run/T22871_cmm.cmm ===================================== @@ -0,0 +1,16 @@ +#include "Cmm.h" + +foo (I64 x) { + switch [0 .. 114514] (x) { + case 0: { return (233 :: I64); } + case 1: { return (333 :: I64); } + case 2: { return (666 :: I64); } + case 3: { return (1989 :: I64); } + case 4: { return (1997 :: I64); } + case 5: { return (2012 :: I64); } + case 6: { return (2019 :: I64); } + case 7: { return (2022 :: I64); } + case 114514: { return (1919810 :: I64); } + default: { return (x * (2 :: I64)); } + } +} ===================================== testsuite/tests/cmm/should_run/all.T ===================================== @@ -25,3 +25,12 @@ test('ByteSwitch', ], multi_compile_and_run, ['ByteSwitch', [('ByteSwitch_cmm.cmm', '')], '']) + +test('T22871', + [ extra_run_opts('"' + config.libdir + '"') + , omit_ways(['ghci']) + , js_skip + , when(arch('i386'), skip) # x86 NCG panics with "iselExpr64(i386)" + ], + multi_compile_and_run, + ['T22871', [('T22871_cmm.cmm', '')], '']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f0eefa3cf058879246991747dcd18c811402f9e5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f0eefa3cf058879246991747dcd18c811402f9e5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 1 06:29:26 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Wed, 01 Feb 2023 01:29:26 -0500 Subject: [Git][ghc/ghc][wip/int-index/decl-invis-binders] 31 commits: ghc-the-library: Retain cafs in both static in dynamic builds. Message-ID: <63da06c61fee5_2a4f45563a981160183@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/decl-invis-binders at Glasgow Haskell Compiler / GHC Commits: 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 1adaeb44 by Vladislav Zavialov at 2023-02-01T09:28:34+03:00 Invisible binders in type declarations (#22560) This patch implements @k-binders introduced in GHC Proposal #425 and guarded behind the TypeAbstractions extension: type D :: forall k j. k -> j -> Type data D @k @j a b = ... ^^ ^^ To represent the new syntax, we modify LHsQTyVars as follows: - hsq_explicit :: [LHsTyVarBndr () pass] + hsq_explicit :: [LHsTyVarBndr (HsBndrVis pass) pass] HsBndrVis is a new data type that records the distinction between type variable binders written with and without the @ sign: data HsBndrVis pass = HsBndrRequired | HsBndrInvisible (LHsToken "@" pass) The rest of the patch updates GHC, template-haskell, and haddock to handle the new syntax. Parser: The PsErrUnexpectedTypeAppInDecl error message is removed. The syntax it used to reject is now permitted. Renamer: The @ sign does not affect the scope of a binder, so the changes to the renamer are minimal. See rnLHsTyVarBndrVisFlag. Type checker: There are three code paths that were updated to deal with the newly introduced invisible type variable binders: 1. checking SAKS: see kcCheckDeclHeader_sig, matchUpSigWithDecl 2. checking CUSK: see kcCheckDeclHeader_cusk 3. inference: see kcInferDeclHeader, rejectInvisibleBinders Helper functions bindExplicitTKBndrs_Q_Skol and bindExplicitTKBndrs_Q_Tv are generalized to work with HsBndrVis. Updates the haddock submodule. Metric Increase: MultiLayerModulesTH_OneShot Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - cabal.project-reinstall - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Reg.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/543b89a50995d93fac59678cad0d28215c5a3920...1adaeb4407c3d380e4c6dcdec37452fe20fe8fb1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/543b89a50995d93fac59678cad0d28215c5a3920...1adaeb4407c3d380e4c6dcdec37452fe20fe8fb1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 1 08:53:51 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 01 Feb 2023 03:53:51 -0500 Subject: [Git][ghc/ghc][wip/T22849] 3 commits: Bump transformers submodule to 0.6.0.6 Message-ID: <63da289f7d968_2a4fa049e4412157c7@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22849 at Glasgow Haskell Compiler / GHC Commits: 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 57c11b0d by Simon Peyton Jones at 2023-02-01T08:54:36+00:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 9 changed files: - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Wasm/ControlFlow/FromCmm.hs - libraries/transformers - + testsuite/tests/cmm/should_run/T22871.hs - + testsuite/tests/cmm/should_run/T22871.stdout - + testsuite/tests/cmm/should_run/T22871_cmm.cmm - testsuite/tests/cmm/should_run/all.T - + testsuite/tests/simplCore/should_compile/T22849.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -707,7 +707,7 @@ Worker/wrapper will unbox * is an algebraic data type (not a newtype) * is not recursive (as per 'isRecDataCon') * has a single constructor (thus is a "product") - * that may bind existentials + * that may bind existentials (#18982) We can transform > data D a = forall b. D a b > f (D @ex a b) = e @@ -1272,16 +1272,25 @@ also unbox its components. That is governed by the `usefulSplit` mechanism. -} -- | Exactly 'dataConInstArgTys', but lacks the (ASSERT'ed) precondition that --- the 'DataCon' may not have existentials. The lack of cloning the existentials --- compared to 'dataConInstExAndArgVars' makes this function \"dubious\"; --- only use it where type variables aren't substituted for! +-- the 'DataCon' may not have existentials. The lack of cloning the +-- existentials this function \"dubious\"; only use it where type variables +-- aren't substituted for! Why may the data con bind existentials? +-- See Note [Which types are unboxed?] dubiousDataConInstArgTys :: DataCon -> [Type] -> [Type] dubiousDataConInstArgTys dc tc_args = arg_tys where - univ_tvs = dataConUnivTyVars dc - ex_tvs = dataConExTyCoVars dc - subst = extendSubstInScopeList (zipTvSubst univ_tvs tc_args) ex_tvs - arg_tys = map (GHC.Core.Type.substTy subst . scaledThing) (dataConRepArgTys dc) + univ_tvs = dataConUnivTyVars dc + ex_tvs = dataConExTyCoVars dc + univ_subst = zipTvSubst univ_tvs tc_args + (full_subst, _) = substTyVarBndrs univ_subst ex_tvs + arg_tys = map (substTy full_subst . scaledThing) $ + dataConRepArgTys dc + -- NB: use substTyVarBndrs on ex_tvs to ensure that we + -- substitute in their kinds. For example (#22849) + -- Consider data T a where + -- MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a + -- Then dubiousDataConInstArgTys MkT [Type, Foo] should return + -- [Foo (ix::Type)], not [Foo (ix::k)]! findTypeShape :: FamInstEnvs -> Type -> TypeShape -- Uncover the arrow and product shape of a type ===================================== compiler/GHC/Wasm/ControlFlow/FromCmm.hs ===================================== @@ -75,7 +75,7 @@ flowLeaving platform b = let (offset, target_labels) = switchTargetsToTable targets (lo, hi) = switchTargetsRange targets default_label = switchTargetsDefault targets - scrutinee = smartPlus platform e offset + scrutinee = smartExtend platform $ smartPlus platform e offset range = inclusiveInterval (lo+toInteger offset) (hi+toInteger offset) in Switch scrutinee range target_labels default_label CmmCall { cml_cont = Nothing, cml_target = e } -> TailCall e @@ -314,6 +314,14 @@ structuredControl platform txExpr txBlock g = nodeBody :: CmmBlock -> CmmActions nodeBody (BlockCC _first middle _last) = middle +-- | A CmmSwitch scrutinee may have any width, but a br_table operand +-- must be exactly word sized, hence the extension here. (#22871) +smartExtend :: Platform -> CmmExpr -> CmmExpr +smartExtend p e | w0 == w1 = e + | otherwise = CmmMachOp (MO_UU_Conv w0 w1) [e] + where + w0 = cmmExprWidth p e + w1 = wordWidth p smartPlus :: Platform -> CmmExpr -> Int -> CmmExpr smartPlus _ e 0 = e ===================================== libraries/transformers ===================================== @@ -1 +1 @@ -Subproject commit 2745db6c374c7e830a0f8fdeb8cc39bd8f054f36 +Subproject commit ceff1dcd7893f7ab4abb6e66bcd248abd86c8886 ===================================== testsuite/tests/cmm/should_run/T22871.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnliftedFFITypes #-} + +import Data.Foldable +import GHC.Exts +import GHC.Int + +foreign import prim "foo" foo :: Int64# -> Int64# + +main :: IO () +main = for_ [0, 42, 114514] $ \(I64# x#) -> print $ I64# (foo x#) ===================================== testsuite/tests/cmm/should_run/T22871.stdout ===================================== @@ -0,0 +1,3 @@ +233 +84 +1919810 ===================================== testsuite/tests/cmm/should_run/T22871_cmm.cmm ===================================== @@ -0,0 +1,16 @@ +#include "Cmm.h" + +foo (I64 x) { + switch [0 .. 114514] (x) { + case 0: { return (233 :: I64); } + case 1: { return (333 :: I64); } + case 2: { return (666 :: I64); } + case 3: { return (1989 :: I64); } + case 4: { return (1997 :: I64); } + case 5: { return (2012 :: I64); } + case 6: { return (2019 :: I64); } + case 7: { return (2022 :: I64); } + case 114514: { return (1919810 :: I64); } + default: { return (x * (2 :: I64)); } + } +} ===================================== testsuite/tests/cmm/should_run/all.T ===================================== @@ -25,3 +25,12 @@ test('ByteSwitch', ], multi_compile_and_run, ['ByteSwitch', [('ByteSwitch_cmm.cmm', '')], '']) + +test('T22871', + [ extra_run_opts('"' + config.libdir + '"') + , omit_ways(['ghci']) + , js_skip + , when(arch('i386'), skip) # x86 NCG panics with "iselExpr64(i386)" + ], + multi_compile_and_run, + ['T22871', [('T22871_cmm.cmm', '')], '']) ===================================== testsuite/tests/simplCore/should_compile/T22849.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE GADTs #-} + +module T22849 where + +data Foo a where + Foo :: Foo Int + +data Bar a = Bar a (Foo a) + +data Some t = forall ix. Some (t ix) + +instance Show (Some Bar) where + show (Some (Bar v t)) = case t of + Foo -> show v ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -453,7 +453,7 @@ test('T22375', normal, compile, ['-O -ddump-simpl -dsuppress-uniques -dno-typeab test('T21851_2', [grep_errmsg(r'wwombat') ], multimod_compile, ['T21851_2', '-O -dno-typeable-binds -dsuppress-uniques']) # Should not inline m, so there shouldn't be a single YES test('T22317', [grep_errmsg(r'ANSWER = YES') ], compile, ['-O -dinline-check m -ddebug-output']) - +test('T22849', normal, compile, ['-O']) test('T22634', normal, compile, ['-O -fcatch-nonexhaustive-cases']) test('T22494', [grep_errmsg(r'case') ], compile, ['-O -ddump-simpl -dsuppress-uniques']) test('T22491', normal, compile, ['-O2']) @@ -472,3 +472,4 @@ test('T22611', [when(wordsize(32), skip), grep_errmsg(r'\$salterF') ], compile, test('T22715_2', normal, multimod_compile, ['T22715_2', '-v0 -O -fspecialise-aggressively']) test('T22802', normal, compile, ['-O']) test('T15205', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8ce7f5f392a4b3c034b7976ef78c4e5cf3201c78...57c11b0d257e399220eb1d42fb4c7e909c07b347 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8ce7f5f392a4b3c034b7976ef78c4e5cf3201c78...57c11b0d257e399220eb1d42fb4c7e909c07b347 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 1 08:54:28 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 01 Feb 2023 03:54:28 -0500 Subject: [Git][ghc/ghc][wip/T19847] 3 commits: Bump transformers submodule to 0.6.0.6 Message-ID: <63da28c4cf0ed_2a4f45563a981216963@gitlab.mail> Simon Peyton Jones pushed to branch wip/T19847 at Glasgow Haskell Compiler / GHC Commits: 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 17 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Wasm/ControlFlow/FromCmm.hs - libraries/transformers - + testsuite/tests/cmm/should_run/T22871.hs - + testsuite/tests/cmm/should_run/T22871.stdout - + testsuite/tests/cmm/should_run/T22871_cmm.cmm - testsuite/tests/cmm/should_run/all.T - + testsuite/tests/gadt/T19847.hs - + testsuite/tests/gadt/T19847a.hs - + testsuite/tests/gadt/T19847a.stderr - + testsuite/tests/gadt/T19847b.hs - testsuite/tests/gadt/all.T - + testsuite/tests/typecheck/should_compile/T19577.hs - + testsuite/tests/typecheck/should_compile/T21501.hs - + testsuite/tests/typecheck/should_compile/T22383.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -441,6 +441,7 @@ data DataCon -- INVARIANT(dataConTyVars): the set of tyvars in dcUserTyVarBinders is -- exactly the set of tyvars (*not* covars) of dcExTyCoVars unioned -- with the set of dcUnivTyVars whose tyvars do not appear in dcEqSpec + -- So dcUserTyVarBinders is a subset of (dcUnivTyVars ++ dcExTyCoVars) -- See Note [DataCon user type variable binders] dcUserTyVarBinders :: [InvisTVBinder], ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -72,9 +72,12 @@ import Control.Arrow ( second ) import Control.Monad import GHC.Data.FastString import qualified Data.List.NonEmpty as NE + import GHC.Data.List.SetOps ( getNth ) import Language.Haskell.Syntax.Basic (FieldLabelString(..)) +import Data.List( partition ) + {- ************************************************************************ * * @@ -315,6 +318,11 @@ type Checker inp out = forall r. , r -- Result of thing inside ) +tcMultiple_ :: Checker inp () -> PatEnv -> [inp] -> TcM r -> TcM r +tcMultiple_ tc_pat penv args thing_inside + = do { (_, res) <- tcMultiple tc_pat penv args thing_inside + ; return res } + tcMultiple :: Checker inp out -> Checker [inp] [out] tcMultiple tc_pat penv args thing_inside = do { err_ctxt <- getErrCtxt @@ -861,10 +869,10 @@ tcConPat :: PatEnv -> LocatedN Name tcConPat penv con_lname@(L _ con_name) pat_ty arg_pats thing_inside = do { con_like <- tcLookupConLike con_name ; case con_like of - RealDataCon data_con -> tcDataConPat penv con_lname data_con - pat_ty arg_pats thing_inside - PatSynCon pat_syn -> tcPatSynPat penv con_lname pat_syn - pat_ty arg_pats thing_inside + RealDataCon data_con -> tcDataConPat con_lname data_con pat_ty + penv arg_pats thing_inside + PatSynCon pat_syn -> tcPatSynPat con_lname pat_syn pat_ty + penv arg_pats thing_inside } -- Warn when pattern matching on a GADT or a pattern synonym @@ -880,12 +888,11 @@ warnMonoLocalBinds -- In #20485 this was made into a warning. } -tcDataConPat :: PatEnv -> LocatedN Name -> DataCon +tcDataConPat :: LocatedN Name -> DataCon -> Scaled ExpSigmaTypeFRR -- Type of the pattern - -> HsConPatDetails GhcRn -> TcM a - -> TcM (Pat GhcTc, a) -tcDataConPat penv (L con_span con_name) data_con pat_ty_scaled - arg_pats thing_inside + -> Checker (HsConPatDetails GhcRn) (Pat GhcTc) +tcDataConPat (L con_span con_name) data_con pat_ty_scaled + penv arg_pats thing_inside = do { let tycon = dataConTyCon data_con -- For data families this is the representation tycon (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _) @@ -921,21 +928,15 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty_scaled -- Why "super"? See Note [Binding when looking up instances] -- in GHC.Core.InstEnv. - ; let arg_tys' = substScaledTys tenv arg_tys - pat_mult = scaledMult pat_ty_scaled + ; let arg_tys' = substScaledTys tenv arg_tys + pat_mult = scaledMult pat_ty_scaled arg_tys_scaled = map (scaleScaled pat_mult) arg_tys' + con_like = RealDataCon data_con -- This check is necessary to uphold the invariant that 'tcConArgs' -- is given argument types with a fixed runtime representation. -- See test case T20363. - ; zipWithM_ - ( \ i arg_sty -> - hasFixedRuntimeRep_syntactic - (FRRDataConPatArg data_con i) - (scaledThing arg_sty) - ) - [1..] - arg_tys' + ; checkFixedRuntimeRep data_con arg_tys' ; traceTc "tcConPat" (vcat [ text "con_name:" <+> ppr con_name , text "univ_tvs:" <+> pprTyVars univ_tvs @@ -947,11 +948,15 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty_scaled , text "pat_ty:" <+> ppr pat_ty , text "arg_tys':" <+> ppr arg_tys' , text "arg_pats" <+> ppr arg_pats ]) + + ; (univ_ty_args, ex_ty_args) <- splitConTyArgs con_like arg_pats + ; if null ex_tvs && null eq_spec && null theta then do { -- The common case; no class bindings etc -- (see Note [Arrows and patterns]) - (arg_pats', res) <- tcConArgs (RealDataCon data_con) arg_tys_scaled - tenv penv arg_pats thing_inside + (arg_pats', res) <- tcConTyArgs tenv penv univ_ty_args $ + tcConValArgs con_like arg_tys_scaled + penv arg_pats thing_inside ; let res_pat = ConPat { pat_con = header , pat_args = arg_pats' , pat_con_ext = ConPatTc @@ -974,8 +979,11 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty_scaled ; given <- newEvVars theta' ; (ev_binds, (arg_pats', res)) - <- checkConstraints (getSkolemInfo skol_info) ex_tvs' given $ - tcConArgs (RealDataCon data_con) arg_tys_scaled tenv penv arg_pats thing_inside + <- -- See Note [Type applications in patterns] (W4) + tcConTyArgs tenv penv univ_ty_args $ + checkConstraints (getSkolemInfo skol_info) ex_tvs' given $ + tcConTyArgs tenv penv ex_ty_args $ + tcConValArgs con_like arg_tys_scaled penv arg_pats thing_inside ; let res_pat = ConPat { pat_con = header @@ -991,11 +999,10 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty_scaled ; return (mkHsWrapPat wrap res_pat pat_ty, res) } } -tcPatSynPat :: PatEnv -> LocatedN Name -> PatSyn +tcPatSynPat :: LocatedN Name -> PatSyn -> Scaled ExpSigmaType -- ^ Type of the pattern - -> HsConPatDetails GhcRn -> TcM a - -> TcM (Pat GhcTc, a) -tcPatSynPat penv (L con_span con_name) pat_syn pat_ty arg_pats thing_inside + -> Checker (HsConPatDetails GhcRn) (Pat GhcTc) +tcPatSynPat (L con_span con_name) pat_syn pat_ty penv arg_pats thing_inside = do { let (univ_tvs, req_theta, ex_tvs, prov_theta, arg_tys, ty) = patSynSig pat_syn ; (subst, univ_tvs') <- newMetaTyVars univ_tvs @@ -1018,23 +1025,27 @@ tcPatSynPat penv (L con_span con_name) pat_syn pat_ty arg_pats thing_inside arg_tys_scaled = map (scaleScaled pat_mult) arg_tys' prov_theta' = substTheta tenv prov_theta req_theta' = substTheta tenv req_theta + con_like = PatSynCon pat_syn ; when (any isEqPred prov_theta) warnMonoLocalBinds ; mult_wrap <- checkManyPattern pat_ty -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify. - ; wrap <- tc_sub_type penv (scaledThing pat_ty) ty' - ; traceTc "tcPatSynPat" (ppr pat_syn $$ - ppr pat_ty $$ - ppr ty' $$ - ppr ex_tvs' $$ - ppr prov_theta' $$ - ppr req_theta' $$ - ppr arg_tys') + ; (univ_ty_args, ex_ty_args) <- splitConTyArgs con_like arg_pats - ; prov_dicts' <- newEvVars prov_theta' + ; wrap <- tc_sub_type penv (scaledThing pat_ty) ty' + ; traceTc "tcPatSynPat" $ + vcat [ text "Pat syn:" <+> ppr pat_syn + , text "Expected type:" <+> ppr pat_ty + , text "Pat res ty:" <+> ppr ty' + , text "ex_tvs':" <+> pprTyVars ex_tvs' + , text "prov_theta':" <+> ppr prov_theta' + , text "req_theta':" <+> ppr req_theta' + , text "arg_tys':" <+> ppr arg_tys' + , text "univ_ty_args:" <+> ppr univ_ty_args + , text "ex_ty_args:" <+> ppr ex_ty_args ] ; req_wrap <- instCall (OccurrenceOf con_name) (mkTyVarTys univ_tvs') req_theta' -- Origin (OccurrenceOf con_name): @@ -1055,11 +1066,16 @@ tcPatSynPat penv (L con_span con_name) pat_syn pat_ty arg_pats thing_inside , text "bad_arg_tys:" <+> ppr bad_arg_tys ] ; traceTc "checkConstraints {" Outputable.empty + ; prov_dicts' <- newEvVars prov_theta' ; (ev_binds, (arg_pats', res)) - <- checkConstraints (getSkolemInfo skol_info) ex_tvs' prov_dicts' $ - tcConArgs (PatSynCon pat_syn) arg_tys_scaled tenv penv arg_pats thing_inside - + <- -- See Note [Type applications in patterns] (W4) + tcConTyArgs tenv penv univ_ty_args $ + checkConstraints (getSkolemInfo skol_info) ex_tvs' prov_dicts' $ + tcConTyArgs tenv penv ex_ty_args $ + tcConValArgs con_like arg_tys_scaled penv arg_pats $ + thing_inside ; traceTc "checkConstraints }" (ppr ev_binds) + ; let res_pat = ConPat { pat_con = L con_span $ PatSynCon pat_syn , pat_args = arg_pats' , pat_con_ext = ConPatTc @@ -1073,6 +1089,14 @@ tcPatSynPat penv (L con_span con_name) pat_syn pat_ty arg_pats thing_inside ; pat_ty <- readExpType (scaledThing pat_ty) ; return (mkHsWrapPat (wrap <.> mult_wrap) res_pat pat_ty, res) } +checkFixedRuntimeRep :: DataCon -> [Scaled TcSigmaTypeFRR] -> TcM () +checkFixedRuntimeRep data_con arg_tys + = zipWithM_ check_one [1..] arg_tys + where + check_one i arg_ty = hasFixedRuntimeRep_syntactic + (FRRDataConPatArg data_con i) + (scaledThing arg_ty) + {- Note [Call-stack tracing of pattern synonyms] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider @@ -1187,84 +1211,128 @@ Suppose (coi, tys) = matchExpectedConType data_tc pat_ty error messages; it's a purely internal thing -} -{- -Note [Typechecking type applications in patterns] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -How should we typecheck type applications in patterns, such as +{- Note [Type applications in patterns] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Type applications in patterns are enabled by -XTypeAbstractions. +For example: f :: Either (Maybe a) [b] -> blah f (Left @x @[y] (v::Maybe x)) = blah -It's quite straightforward, and very similar to the treatment of -pattern signatures. +How should we typecheck them? The basic plan is pretty simple, and is +all done in tcConTyArgs. For each type argument: -* Step 1: bind the newly-in-scope type variables x and y to fresh - unification variables, say x0 and y0. +* Step 1: + * bind the newly-in-scope type variables (here `x` or `y`) to + unification variables, say `x0` or `y0` -* Step 2: typecheck those type arguments, @x and @[y], to get the - types x0 and [y0]. + * typecheck the type argument, `@x` or `@[y]` to get the + types `x0` or `[y0]`. -* Step 3: Unify those types with the type arguments we expect, - in this case (Maybe a) and [b]. These unifications will - (perhaps after the constraint solver has done its work) + This step is done by `tcHsPatSigType`, similar to the way we + deal with pattern signatures. + +* Step 2: Unify those types with the type arguments we expect from + the context, in this case (Maybe a) and [b]. These unifications + will (perhaps after the constraint solver has done its work) unify x0 := Maybe a y0 := b Thus we learn that x stands for (Maybe a) and y for b. -Wrinkles: - -* Surprisingly, we can discard the coercions arising from - these unifications. The *only* thing the unification does is - to side-effect those unification variables, so that we know - what type x and y stand for; and cause an error if the equality - is not soluble. It's a bit like a constraint arising - from a functional dependency, where we don't use the evidence. - -* Exactly the same works for existential arguments - data T where - MkT :: a -> a -> T - f :: T -> blah - f (MkT @x v w) = ... - Here we create a fresh unification variable x0 for x, and - unify it with the fresh existential variable bound by the pattern. - -* Note that both here and in pattern signatures the unification may - not even end up unifying the variable. For example - type S a b = a - f :: Maybe a -> Bool - f (Just @(S a b) x) = True :: b - In Step 3 we will unify (S a0 b0 ~ a), which succeeds, but has no - effect on the unification variable b0, to which 'b' is bound. - Later, in the RHS, we find that b0 must be Bool, and unify it there. - All is fine. +* Step 3: Extend the lexical context to bind `x` to `x0` and + `y` to `y0`, and typecheck the body of the pattern match. + +However there are several quite tricky wrinkles. + +(W1) Surprisingly, we can discard the coercions arising from + these unifications. The *only* thing the unification does is + to side-effect those unification variables, so that we know + what type x and y stand for; and cause an error if the equality + is not soluble. It's a bit like a constraint arising + from a functional dependency, where we don't use the evidence. + +(W2) Note that both here and in pattern signatures the unification may + not even end up unifying the variable. For example + type S a b = a + f :: Maybe a -> Bool + f (Just @(S a b) x) = True :: b + In Step 2 we will unify (S a0 b0 ~ a), which succeeds, but has no + effect on the unification variable b0, to which 'b' is bound. + Later, in the RHS, we find that b0 must be Bool, and unify it there. + All is fine. + +(W3) The order of the arguments to the /data constructor/ may differ from + the order of the arguments to the /type constructor/. Example + data T a b where { MkT :: forall c d. (c,d) -> T d c } + f :: T Int Bool -> blah + f (MkT @x @y p) = ... + The /first/ type argument to `MkT`, namely `@x` corresponds to the + /second/ argument to `T` in the type `T Int Bool`. So `x` is bound + to `Bool` -- not to `Int`!. That is why splitConTyArgs uses + conLikeUserTyVarBinders to match up with the user-supplied type arguments + in the pattern, not dataConUnivTyVars/dataConExTyVars. + +(W4) A similar story works for existentials, but it is subtly different + (#19847). Consider + data T a where { MkT :: forall a b. a -> b -> T a } + f :: T Int -> blah + f (MkT @x @y v w) = blah + Here we create a fresh unification variables x0,y0 for x,y and + unify x0~Int, y0~b, where b is the fresh existential variable bound by + the pattern. But + * (x0~Int) must be /outside/ the implication constraint + * (y0~b) must be /inside/ it + (and hence x0 and y0 themselves must have different levels). + Thus: + x0[1]~Int, (forall[2] b. (y0[2]~b, ...constraints-from-blah...)) + + We need (x0~Int) /outside/ so that it can influence the type of the + pattern in an inferred setting, e.g. + g :: T _ -> blah + g (MkT @Int @y v w) = blah + Here we want to infer `g` to have type `T Int -> blah`. If the + (x0~Int) was inside the implication, and the the constructor bound + equality constraints, `x0` would be untouchable. This was the root + cause of #19847. + + We need (y0~b) to be /inside/ the implication, so that `b` is in + scope. In fact, we may actually /need/ equalities bound by the + implication to prove the equality constraint we generate. + Example data T a where + MkT :: forall p q. T (p,q) + f :: T (Int,Bool) -> blah + f (MkT @Int @Bool) = ... + We get the implication + forall[2] p q. (p,q)~(Int,Bool) => (p ~ Int, q ~ Bool, ...) + where the Given comes from the GADT match, while (p~Int, q~Bool) + comes from matching the type arguments. + + Wow. That's all quite subtle! See the long discussion on #19847. We + must treat universal and existential arguments separately, even though + they are all mixed up (W3). The function splitConTyArgs separates the + universals from existentials; and we build the implication between + typechecking the two sets: + tcConTyArgs ... univ_ty_args $ + checkConstraints ... $ + tcConTyArgs ... ex_ty_args $ + ..typecheck body.. + You can see this code shape in tcDataConPat and tcPatSynPat. + + Where pattern synonyms are involved, this two-level split may not be + enough. See #22328 for the story. -} -tcConArgs :: ConLike - -> [Scaled TcSigmaTypeFRR] - -> Subst -- Instantiating substitution for constructor type - -> Checker (HsConPatDetails GhcRn) (HsConPatDetails GhcTc) -tcConArgs con_like arg_tys tenv penv con_args thing_inside = case con_args of +tcConValArgs :: ConLike + -> [Scaled TcSigmaTypeFRR] + -> Checker (HsConPatDetails GhcRn) (HsConPatDetails GhcTc) +tcConValArgs con_like arg_tys penv con_args thing_inside = case con_args of PrefixCon type_args arg_pats -> do + -- NB: type_args already dealt with + -- See Note [Type applications in patterns] { checkTc (con_arity == no_of_args) -- Check correct arity (arityErr (text "constructor") con_like con_arity no_of_args) - -- forgetting to filter out inferred binders led to #20443 - ; let con_spec_binders = filter ((== SpecifiedSpec) . binderFlag) $ - conLikeUserTyVarBinders con_like - ; checkTc (type_args `leLength` con_spec_binders) - (TcRnTooManyTyArgsInConPattern con_like (length con_spec_binders) (length type_args)) - ; let pats_w_tys = zipEqual "tcConArgs" arg_pats arg_tys - ; (type_args', (arg_pats', res)) - <- tcMultiple tcConTyArg penv type_args $ - tcMultiple tcConArg penv pats_w_tys thing_inside - - -- This unification is straight from Figure 7 of - -- "Type Variables in Patterns", Haskell'18 - ; _ <- zipWithM (unifyType Nothing) type_args' (substTyVars tenv $ - binderVars con_spec_binders) - -- OK to drop coercions here. These unifications are all about - -- guiding inference based on a user-written type annotation - -- See Note [Typechecking type applications in patterns] + ; (arg_pats', res) <- tcMultiple tcConArg penv pats_w_tys thing_inside ; return (PrefixCon type_args arg_pats', res) } where @@ -1321,23 +1389,72 @@ tcConArgs con_like arg_tys tenv penv con_args thing_inside = case con_args of -- dataConFieldLabels will be empty (and each field in the pattern -- will generate an error below). -tcConTyArg :: Checker (HsConPatTyArg GhcRn) TcType -tcConTyArg penv (HsConPatTyArg _ rn_ty) thing_inside + +splitConTyArgs :: ConLike -> HsConPatDetails GhcRn + -> TcM ( [(HsConPatTyArg GhcRn, TyVar)] -- Universals + , [(HsConPatTyArg GhcRn, TyVar)] ) -- Existentials +-- See Note [Type applications in patterns] (W4) +-- This function is monadic only because of the error check +-- for too many type arguments +splitConTyArgs con_like (PrefixCon type_args _) + = do { checkTc (type_args `leLength` con_spec_bndrs) + (TcRnTooManyTyArgsInConPattern con_like + (length con_spec_bndrs) (length type_args)) + ; if null ex_tvs -- Short cut common case + then return (bndr_ty_arg_prs, []) + else return (partition is_universal bndr_ty_arg_prs) } + where + ex_tvs = conLikeExTyCoVars con_like + con_spec_bndrs = [ tv | Bndr tv SpecifiedSpec <- conLikeUserTyVarBinders con_like ] + -- conLikeUserTyVarBinders: see (W3) in + -- Note [Type applications in patterns] + -- SpecifiedSpec: forgetting to filter out inferred binders led to #20443 + + bndr_ty_arg_prs = type_args `zip` con_spec_bndrs + -- The zip truncates to length(type_args) + + is_universal (_, tv) = not (tv `elem` ex_tvs) + -- See Note [DataCon user type variable binders] in GHC.Core.DataCon + -- especially INVARIANT(dataConTyVars). + +splitConTyArgs _ (RecCon {}) = return ([], []) -- No type args in RecCon +splitConTyArgs _ (InfixCon {}) = return ([], []) -- No type args in InfixCon + +tcConTyArgs :: Subst -> PatEnv -> [(HsConPatTyArg GhcRn, TyVar)] + -> TcM a -> TcM a +tcConTyArgs tenv penv prs thing_inside + = tcMultiple_ (tcConTyArg tenv) penv prs thing_inside + +tcConTyArg :: Subst -> Checker (HsConPatTyArg GhcRn, TyVar) () +tcConTyArg tenv penv (HsConPatTyArg _ rn_ty, con_tv) thing_inside = do { (sig_wcs, sig_ibs, arg_ty) <- tcHsPatSigType TypeAppCtxt HM_TyAppPat rn_ty AnyKind -- AnyKind is a bit suspect: it really should be the kind gotten -- from instantiating the constructor type. But this would be -- hard to get right, because earlier type patterns might influence -- the kinds of later patterns. In any case, it all gets checked - -- by the calls to unifyType in tcConArgs, which will also unify - -- kinds. + -- by the calls to unifyType below which unifies kinds + ; case NE.nonEmpty sig_ibs of Just sig_ibs_ne | inPatBind penv -> addErr (TcRnCannotBindTyVarsInPatBind sig_ibs_ne) _ -> pure () + + -- This unification is straight from Figure 7 of + -- "Type Variables in Patterns", Haskell'18 + -- OK to drop coercions here. These unifications are all about + -- guiding inference based on a user-written type annotation + -- See Note [Type applications in patterns] (W1) + ; _ <- unifyType Nothing arg_ty (substTyVar tenv con_tv) + ; result <- tcExtendNameTyVarEnv sig_wcs $ tcExtendNameTyVarEnv sig_ibs $ thing_inside - ; return (arg_ty, result) } + -- NB: Because we call tConTyArgs twice, once for universals and + -- once for existentials; so this brings things into scope + -- "out of left-right order". But it doesn't matter; the renamer + -- has dealt with all that. + + ; return ((), result) } tcConArg :: Checker (LPat GhcRn, Scaled TcSigmaType) (LPat GhcTc) tcConArg penv (arg_pat, Scaled arg_mult arg_ty) ===================================== compiler/GHC/Wasm/ControlFlow/FromCmm.hs ===================================== @@ -75,7 +75,7 @@ flowLeaving platform b = let (offset, target_labels) = switchTargetsToTable targets (lo, hi) = switchTargetsRange targets default_label = switchTargetsDefault targets - scrutinee = smartPlus platform e offset + scrutinee = smartExtend platform $ smartPlus platform e offset range = inclusiveInterval (lo+toInteger offset) (hi+toInteger offset) in Switch scrutinee range target_labels default_label CmmCall { cml_cont = Nothing, cml_target = e } -> TailCall e @@ -314,6 +314,14 @@ structuredControl platform txExpr txBlock g = nodeBody :: CmmBlock -> CmmActions nodeBody (BlockCC _first middle _last) = middle +-- | A CmmSwitch scrutinee may have any width, but a br_table operand +-- must be exactly word sized, hence the extension here. (#22871) +smartExtend :: Platform -> CmmExpr -> CmmExpr +smartExtend p e | w0 == w1 = e + | otherwise = CmmMachOp (MO_UU_Conv w0 w1) [e] + where + w0 = cmmExprWidth p e + w1 = wordWidth p smartPlus :: Platform -> CmmExpr -> Int -> CmmExpr smartPlus _ e 0 = e ===================================== libraries/transformers ===================================== @@ -1 +1 @@ -Subproject commit 2745db6c374c7e830a0f8fdeb8cc39bd8f054f36 +Subproject commit ceff1dcd7893f7ab4abb6e66bcd248abd86c8886 ===================================== testsuite/tests/cmm/should_run/T22871.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnliftedFFITypes #-} + +import Data.Foldable +import GHC.Exts +import GHC.Int + +foreign import prim "foo" foo :: Int64# -> Int64# + +main :: IO () +main = for_ [0, 42, 114514] $ \(I64# x#) -> print $ I64# (foo x#) ===================================== testsuite/tests/cmm/should_run/T22871.stdout ===================================== @@ -0,0 +1,3 @@ +233 +84 +1919810 ===================================== testsuite/tests/cmm/should_run/T22871_cmm.cmm ===================================== @@ -0,0 +1,16 @@ +#include "Cmm.h" + +foo (I64 x) { + switch [0 .. 114514] (x) { + case 0: { return (233 :: I64); } + case 1: { return (333 :: I64); } + case 2: { return (666 :: I64); } + case 3: { return (1989 :: I64); } + case 4: { return (1997 :: I64); } + case 5: { return (2012 :: I64); } + case 6: { return (2019 :: I64); } + case 7: { return (2022 :: I64); } + case 114514: { return (1919810 :: I64); } + default: { return (x * (2 :: I64)); } + } +} ===================================== testsuite/tests/cmm/should_run/all.T ===================================== @@ -25,3 +25,12 @@ test('ByteSwitch', ], multi_compile_and_run, ['ByteSwitch', [('ByteSwitch_cmm.cmm', '')], '']) + +test('T22871', + [ extra_run_opts('"' + config.libdir + '"') + , omit_ways(['ghci']) + , js_skip + , when(arch('i386'), skip) # x86 NCG panics with "iselExpr64(i386)" + ], + multi_compile_and_run, + ['T22871', [('T22871_cmm.cmm', '')], '']) ===================================== testsuite/tests/gadt/T19847.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE GADTs, PatternSynonyms, ViewPatterns, ScopedTypeVariables #-} + +module T19847 where + +import Data.Kind +import Type.Reflection + +pattern Is :: forall (b :: Type) (a :: Type). Typeable b => (a ~ b) => TypeRep a +pattern Is <- (eqTypeRep (typeRep @b) -> Just HRefl) + where Is = typeRep + +def :: TypeRep a -> a +def x = case x of + Is @Int -> 10 + Is @Bool -> False ===================================== testsuite/tests/gadt/T19847a.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE LambdaCase, GADTs, ScopedTypeVariables, TypeAbstractions #-} + +module T19847a where + +data T a b c where + MkT :: forall c y x b. (x~y, c~[x], Ord x) => x -> y -> T (x,y) b c + +f :: forall b c. (T (Int,Int) b c -> Bool) -> (b,c) +f = error "urk" + +h = f (\case { MkT @_ @_ @_ @Int p q -> True }) +-- Check that the @Int argument can affect +-- the type at which `f` is instantiated +-- So h :: forall c. (Int,c) ===================================== testsuite/tests/gadt/T19847a.stderr ===================================== @@ -0,0 +1,12 @@ +TYPE SIGNATURES + f :: forall b c. (T (Int, Int) b c -> Bool) -> (b, c) + h :: forall {c}. (Int, c) +TYPE CONSTRUCTORS + data type T{4} :: forall {k}. * -> k -> * -> * + roles nominal nominal phantom nominal +DATA CONSTRUCTORS + MkT :: forall {k} c y x (b :: k). + (x ~ y, c ~ [x], Ord x) => + x -> y -> T (x, y) b c +Dependent modules: [] +Dependent packages: [base-4.18.0.0] ===================================== testsuite/tests/gadt/T19847b.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeAbstractions, GADTs #-} + +module T19847b where + +import Data.Kind + +data T (a :: Type) b where + MkT4 :: forall a b. b ~ a => T a b + +foo x = (case x of MkT4 @Bool -> ()) :: () ===================================== testsuite/tests/gadt/all.T ===================================== @@ -126,3 +126,6 @@ test('SynDataRec', normal, compile, ['']) test('T20485', normal, compile, ['']) test('T20485a', normal, compile, ['']) test('T22235', normal, compile, ['']) +test('T19847', normal, compile, ['']) +test('T19847a', normal, compile, ['-ddump-types']) +test('T19847b', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_compile/T19577.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RankNTypes #-} + +module T19577 where + +data SBool (b :: Bool) where + STrue :: forall b. (b ~ 'True) => SBool b + SFalse :: forall b. (b ~ 'False) => SBool b + +class Blah b where + blah :: SBool b + +instance Blah 'True where + blah = STrue + +foo :: Blah b => (SBool b -> Int) -> Int +foo f = f blah + +bar = foo (\(STrue @True) -> 42) ===================================== testsuite/tests/typecheck/should_compile/T21501.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE MonoLocalBinds, PatternSynonyms, ViewPatterns, TypeAbstractions #-} + +module T21501 where + +import Data.Kind +import Type.Reflection + +pattern TypeApp :: + forall {k1} {k2} (f :: k1 -> k2) (result :: k2). + Typeable f => + forall (arg :: k1). + result ~ f arg => + TypeRep arg -> + TypeRep result +pattern TypeApp arg_rep <- App (eqTypeRep (typeRep @f) -> Just HRefl) arg_rep + +f :: TypeRep (a :: Type) -> String +f (TypeApp @[] rep) = show rep + +{- Expected type: TypeRep k (a::k) + Instantiate at k10 k20 (f0 :: k10 -> k20) (result0 :: k20) + Unify (TypeRep k (a::k) ~ TypeRep k20 (result :: k20) + Unify f0 ~ [] +-} ===================================== testsuite/tests/typecheck/should_compile/T22383.hs ===================================== @@ -0,0 +1,83 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase, ScopedTypeVariables #-} + +module T22383 where + +import Data.Kind (Type) +import Data.Proxy (Proxy(Proxy)) + +-- | @IsType k@ witnesses that @k ~ Type at . +data IsType k where + IsType :: IsType Type + +--------------------- +-- Using a GADT +--------------------- + +data FromType where + FromType :: forall (f :: Type -> Type). FromType + +-- | @FunRep (f b)@ witnesses that @b :: Type at . +data FunRep a where + AppK :: + forall (k :: Type) (f :: k -> Type) (b :: k). + IsType k -> + Proxy f -> + FunRep (f b) + +-- Could not deduce: k ~ * +isMaybeF :: forall (a :: Type). FunRep a -> FromType +isMaybeF = \case + AppK @_ @f @_ t (Proxy @g :: Proxy h) -> + case t of + IsType -> FromType @f + +-- Could not deduce: k ~ * +isMaybeG :: forall (a :: Type). FunRep a -> FromType +isMaybeG = \case + AppK @_ @f @_ t (Proxy @g :: Proxy h) -> + case t of + IsType -> FromType @g + +-- Works fine +isMaybeH :: forall (a :: Type). FunRep a -> FromType +isMaybeH = \case + AppK @_ @f @_ t (Proxy @g :: Proxy h) -> + case t of + IsType -> FromType @h + + +--------------------- +-- Not using a GADT +--------------------- + +data FunRep2 a where + AppK2 :: + forall k (b :: k). + IsType k -> + Proxy k -> + FunRep2 b + +data FromType2 where + FromType2 :: forall (b :: Type). FromType2 + +-- Could not deduce: k ~ * +isMaybeF2 :: forall k (a :: k). FunRep2 a -> FromType2 +isMaybeF2 = \case + AppK2 @_ @f t (Proxy @g :: Proxy h) -> + case t of + IsType -> FromType2 @f + +-- Works fine +isMaybeG2 :: forall k (a :: k). FunRep2 a -> FromType2 +isMaybeG2 = \case + AppK2 @_ @f t (Proxy @g :: Proxy h) -> + case t of + IsType -> FromType2 @g + +-- Works fine +isMaybeH2 :: forall k (a :: k). FunRep2 a -> FromType2 +isMaybeH2 = \case + AppK2 @_ @f t (Proxy @g :: Proxy h) -> + case t of + IsType -> FromType2 @h ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -854,3 +854,6 @@ test('T22310', normal, compile, ['']) test('T22331', normal, compile, ['']) test('T22516', normal, compile, ['']) test('T22647', normal, compile, ['']) +test('T19577', normal, compile, ['']) +test('T22383', normal, compile, ['']) +test('T21501', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5e08cf714bf976dc86a7174d2443bedd9c18e3b0...9f95db54e38b21782d058043abe42fd77abfb9ad -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5e08cf714bf976dc86a7174d2443bedd9c18e3b0...9f95db54e38b21782d058043abe42fd77abfb9ad You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 1 08:59:32 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 01 Feb 2023 03:59:32 -0500 Subject: [Git][ghc/ghc][wip/t21936] 19 commits: Assorted changes to avoid Data.List.{head,tail} Message-ID: <63da29f4ba7d1_2a4f45563a9812205b1@gitlab.mail> Matthew Pickering pushed to branch wip/t21936 at Glasgow Haskell Compiler / GHC Commits: 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 199b6cfd by Matthew Pickering at 2023-02-01T08:59:17+00:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - 142183e4 by Matthew Pickering at 2023-02-01T08:59:17+00:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - cabal.project-reinstall - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/BlockLayout.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/JS/Make.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/TyThing.hs - compiler/GHC/Utils/Misc.hs - compiler/cbits/keepCAFsForGHCi.c - compiler/ghc.cabal.in - configure.ac - docs/users_guide/exts/instances.rst - docs/users_guide/using-optimisation.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a93f1c124cb30af85a7cd73fb571fa7c328f733a...142183e47053f222796df0ed58f370ac5c6a877a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a93f1c124cb30af85a7cd73fb571fa7c328f733a...142183e47053f222796df0ed58f370ac5c6a877a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 1 09:46:57 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Wed, 01 Feb 2023 04:46:57 -0500 Subject: [Git][ghc/ghc][wip/9.2.6-backports] 9 commits: Handle shadowing in DmdAnal (#22718) Message-ID: <63da3511d46e0_2a4f55f50125659b@gitlab.mail> Zubin pushed to branch wip/9.2.6-backports at Glasgow Haskell Compiler / GHC Commits: 80d1180a by Sebastian Graf at 2023-02-01T15:08:40+05:30 Handle shadowing in DmdAnal (#22718) Previously, when we had a shadowing situation like ```hs f x = ... -- demand signature <1L><1L> main = ... \f -> f 1 ... ``` we'd happily use the shadowed demand signature at the call site inside the lambda. Of course, that's wrong and solution is simply to remove the demand signature from the `AnalEnv` when we enter the lambda. This patch does so for all binding constructs Core. In #22718 the issue was caused by LetUp not shadowing away the existing demand signature for the let binder in the let body. The resulting absent error is fickle to reproduce; hence no reproduction test case. #17478 would help. Fixes #22718. It appears that TcPlugin_Rewrite regresses by ~40% on Darwin. It is likely that DmdAnal was exploiting ill-scoped analysis results. Metric increase ['bytes allocated'] (test_env=x86_64-darwin-validate): TcPlugin_Rewrite (cherry picked from commit e3fff7512bbf989386faaa1dccafdad1deabde84) - - - - - 6671528c by Zubin Duggal at 2023-02-01T15:08:40+05:30 Bump bytestring - - - - - f09f1253 by Andreas Klebinger at 2023-02-01T15:08:40+05:30 Only gc sparks locally when we can ensure marking is done. When performing GC without work stealing there was no guarantee that spark pruning was happening after marking of the sparks. This could cause us to GC live sparks under certain circumstances. Fixes #22528. (cherry picked from commit a1491c8791c57a64d94bc08d639d585815c8d4e2) - - - - - 45cea818 by Ian-Woo Kim at 2023-02-01T15:08:40+05:30 Truncate eventlog event for large payload (#20221) RTS eventlog events for postCapsetVecEvent are truncated if payload is larger than EVENT_PAYLOAD_SIZE_MAX Previously, postCapsetVecEvent records eventlog event with payload of variable size larger than EVENT_PAYLOAD_SIZE_MAX (2^16) without any validation, resulting in corrupted data. For example, this happens when a Haskell binary is invoked with very long command line arguments exceeding 2^16 bytes (see #20221). Now we check the size of accumulated payload messages incrementally, and truncate the message just before the payload size exceeds EVENT_PAYLOAD_SIZE_MAX. RTS will warn the user with a message showing how many arguments are truncated. (cherry picked from commit 2057c77d08cb8422857d182a3691f98dccd0c7d6) - - - - - e4c1913f by Simon Peyton Jones at 2023-02-01T15:08:40+05:30 Make FloatIn robust to shadowing This MR fixes #22622. See the new Note [Shadowing and name capture] I did a bit of refactoring in sepBindsByDropPoint too. The bug doesn't manifest in HEAD, but it did show up in 9.4, so we should backport this patch to 9.4 (cherry picked from commit 6206cb9287f3f6e70c669660a646a65274870d2b) - - - - - 18216c18 by Ben Gamari at 2023-02-01T15:08:40+05:30 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. (cherry picked from commit f891a442046d8a5ebf4d4777847880ce06752b18) - - - - - 2b4b118e by Ben Gamari at 2023-02-01T15:08:40+05:30 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. (cherry picked from commit b13c6ea5d4b64841164f8cc58d6c6f3de390f2ed) - - - - - b51bfd52 by Oleg Grenrus at 2023-02-01T15:08:41+05:30 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general (cherry picked from commit 1b812b6973a25cb1962e2fc543d2c4ed3cf31f3c) - - - - - e50494f5 by Zubin Duggal at 2023-02-01T15:15:46+05:30 Document #22255 and #22468 in bugs.rst - - - - - 19 changed files: - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Driver/Main.hs - docs/users_guide/bugs.rst - libraries/bytestring - libraries/ghc-bignum/gmp/gmp-tarballs - rts/Sparks.c - rts/eventlog/EventLog.c - rts/sm/GC.c - + testsuite/tests/safeHaskell/warnings/Makefile - + testsuite/tests/safeHaskell/warnings/T22728.hs - + testsuite/tests/safeHaskell/warnings/T22728.stderr - + testsuite/tests/safeHaskell/warnings/T22728_B.hs - + testsuite/tests/safeHaskell/warnings/T22728b.hs - + testsuite/tests/safeHaskell/warnings/T22728b.stderr - + testsuite/tests/safeHaskell/warnings/T22728b_B.hs - + testsuite/tests/safeHaskell/warnings/all.T - + testsuite/tests/simplCore/should_compile/T22662.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -275,7 +275,7 @@ dmdAnalBindLetUp :: TopLevelFlag -> WithDmdType (DmdResult CoreBind a) dmdAnalBindLetUp top_lvl env id rhs anal_body = WithDmdType final_ty (R (NonRec id' rhs') (body')) where - WithDmdType body_ty body' = anal_body env + WithDmdType body_ty body' = anal_body (addInScopeAnalEnv env id) WithDmdType body_ty' id_dmd = findBndrDmd env notArgOfDfun body_ty id !id' = setBindIdDemandInfo top_lvl id id_dmd (rhs_ty, rhs') = dmdAnalStar env (dmdTransformThunkDmd rhs id_dmd) rhs @@ -405,7 +405,8 @@ dmdAnal' env dmd (App fun arg) dmdAnal' env dmd (Lam var body) | isTyVar var = let - WithDmdType body_ty body' = dmdAnal env dmd body + WithDmdType body_ty body' = dmdAnal (addInScopeAnalEnv env var) dmd body + -- See Note [Bringing a new variable into scope] in WithDmdType body_ty (Lam var body') @@ -413,7 +414,8 @@ dmdAnal' env dmd (Lam var body) = let (n, body_dmd) = peelCallDmd dmd -- body_dmd: a demand to analyze the body - WithDmdType body_ty body' = dmdAnal env body_dmd body + WithDmdType body_ty body' = dmdAnal (addInScopeAnalEnv env var) body_dmd body + -- See Note [Bringing a new variable into scope] WithDmdType lam_ty var' = annotateLamIdBndr env notArgOfDfun body_ty var new_dmd_type = multDmdType n lam_ty in @@ -424,7 +426,9 @@ dmdAnal' env dmd (Case scrut case_bndr ty [Alt alt bndrs rhs]) -- If it's a DataAlt, it should be the only constructor of the type. | is_single_data_alt alt = let - WithDmdType rhs_ty rhs' = dmdAnal env dmd rhs + rhs_env = addInScopeAnalEnvs env (case_bndr:bndrs) + -- See Note [Bringing a new variable into scope] + WithDmdType rhs_ty rhs' = dmdAnal rhs_env dmd rhs WithDmdType alt_ty1 dmds = findBndrsDmds env rhs_ty bndrs WithDmdType alt_ty2 case_bndr_dmd = findBndrDmd env False alt_ty1 case_bndr -- Evaluation cardinality on the case binder is irrelevant and a no-op. @@ -547,7 +551,9 @@ forcesRealWorld fam_envs ty dmdAnalSumAlt :: AnalEnv -> SubDemand -> Id -> Alt Var -> WithDmdType (Alt Var) dmdAnalSumAlt env dmd case_bndr (Alt con bndrs rhs) - | WithDmdType rhs_ty rhs' <- dmdAnal env dmd rhs + | let rhs_env = addInScopeAnalEnvs env (case_bndr:bndrs) + -- See Note [Bringing a new variable into scope] + , WithDmdType rhs_ty rhs' <- dmdAnal rhs_env dmd rhs , WithDmdType alt_ty dmds <- findBndrsDmds env rhs_ty bndrs , let (_ :* case_bndr_sd) = findIdDemand alt_ty case_bndr -- See Note [Demand on scrutinee of a product case] @@ -1437,7 +1443,7 @@ emptyAnalEnv opts fam_envs emptySigEnv :: SigEnv emptySigEnv = emptyVarEnv --- | Extend an environment with the strictness IDs attached to the id +-- | Extend an environment with the strictness sigs attached to the Ids extendAnalEnvs :: TopLevelFlag -> AnalEnv -> [Id] -> AnalEnv extendAnalEnvs top_lvl env vars = env { ae_sigs = extendSigEnvs top_lvl (ae_sigs env) vars } @@ -1456,6 +1462,12 @@ extendSigEnv top_lvl sigs var sig = extendVarEnv sigs var (sig, top_lvl) lookupSigEnv :: AnalEnv -> Id -> Maybe (StrictSig, TopLevelFlag) lookupSigEnv env id = lookupVarEnv (ae_sigs env) id +addInScopeAnalEnv :: AnalEnv -> Var -> AnalEnv +addInScopeAnalEnv env id = env { ae_sigs = delVarEnv (ae_sigs env) id } + +addInScopeAnalEnvs :: AnalEnv -> [Var] -> AnalEnv +addInScopeAnalEnvs env ids = env { ae_sigs = delVarEnvList (ae_sigs env) ids } + nonVirgin :: AnalEnv -> AnalEnv nonVirgin env = env { ae_virgin = False } @@ -1496,8 +1508,20 @@ findBndrDmd env arg_of_dfun dmd_ty id fam_envs = ae_fam_envs env -{- Note [Initialising strictness] +{- Note [Bringing a new variable into scope] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + f x = blah + g = ...(\f. ...f...)... + +In the body of the '\f', any occurrence of `f` refers to the lambda-bound `f`, +not the top-level `f` (which will be in `ae_sigs`). So it's very important +to delete `f` from `ae_sigs` when we pass a lambda/case/let-up binding of `f`. +Otherwise chaos results (#22718). + +Note [Initialising strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + See section 9.2 (Finding fixpoints) of the paper. Our basic plan is to initialise the strictness of each Id in a ===================================== compiler/GHC/Core/Opt/FloatIn.hs ===================================== @@ -43,6 +43,10 @@ import GHC.Unit.Module.ModGuts import GHC.Utils.Misc import GHC.Utils.Panic +import GHC.Utils.Outputable + +import Data.List ( mapAccumL ) + {- Top-level interface function, @floatInwards at . Note that we do not actually float any bindings downwards from the top-level. @@ -132,7 +136,7 @@ the closure for a is not built. ************************************************************************ -} -type FreeVarSet = DIdSet +type FreeVarSet = DVarSet type BoundVarSet = DIdSet data FloatInBind = FB BoundVarSet FreeVarSet FloatBind @@ -140,11 +144,17 @@ data FloatInBind = FB BoundVarSet FreeVarSet FloatBind -- of recursive bindings, the set doesn't include the bound -- variables. -type FloatInBinds = [FloatInBind] - -- In reverse dependency order (innermost binder first) +type FloatInBinds = [FloatInBind] -- In normal dependency order + -- (outermost binder first) +type RevFloatInBinds = [FloatInBind] -- In reverse dependency order + -- (innermost binder first) + +instance Outputable FloatInBind where + ppr (FB bvs fvs _) = text "FB" <> braces (sep [ text "bndrs =" <+> ppr bvs + , text "fvs =" <+> ppr fvs ]) fiExpr :: Platform - -> FloatInBinds -- Binds we're trying to drop + -> RevFloatInBinds -- Binds we're trying to drop -- as far "inwards" as possible -> CoreExprWithFVs -- Input expr -> CoreExpr -- Result @@ -155,13 +165,12 @@ fiExpr _ to_drop (_, AnnType ty) = ASSERT( null to_drop ) Type ty fiExpr _ to_drop (_, AnnVar v) = wrapFloats to_drop (Var v) fiExpr _ to_drop (_, AnnCoercion co) = wrapFloats to_drop (Coercion co) fiExpr platform to_drop (_, AnnCast expr (co_ann, co)) - = wrapFloats (drop_here ++ co_drop) $ + = wrapFloats drop_here $ Cast (fiExpr platform e_drop expr) co where - [drop_here, e_drop, co_drop] - = sepBindsByDropPoint platform False - [freeVarsOf expr, freeVarsOfAnn co_ann] - to_drop + (drop_here, [e_drop]) + = sepBindsByDropPoint platform False to_drop + (freeVarsOfAnn co_ann) [freeVarsOf expr] {- Applications: we do float inside applications, mainly because we @@ -170,7 +179,7 @@ pull out any silly ones. -} fiExpr platform to_drop ann_expr@(_,AnnApp {}) - = wrapFloats drop_here $ wrapFloats extra_drop $ + = wrapFloats drop_here $ mkTicks ticks $ mkApps (fiExpr platform fun_drop ann_fun) (zipWithEqual "fiExpr" (fiExpr platform) arg_drops ann_args) @@ -180,19 +189,18 @@ fiExpr platform to_drop ann_expr@(_,AnnApp {}) (ann_fun, ann_args, ticks) = collectAnnArgsTicks tickishFloatable ann_expr fun_ty = exprType (deAnnotate ann_fun) fun_fvs = freeVarsOf ann_fun - arg_fvs = map freeVarsOf ann_args - (drop_here : extra_drop : fun_drop : arg_drops) - = sepBindsByDropPoint platform False - (extra_fvs : fun_fvs : arg_fvs) - to_drop + (drop_here, fun_drop : arg_drops) + = sepBindsByDropPoint platform False to_drop + here_fvs (fun_fvs : arg_fvs) + -- Shortcut behaviour: if to_drop is empty, -- sepBindsByDropPoint returns a suitable bunch of empty -- lists without evaluating extra_fvs, and hence without -- peering into each argument - (_, extra_fvs) = foldl' add_arg (fun_ty, extra_fvs0) ann_args - extra_fvs0 = case ann_fun of + ((_,here_fvs), arg_fvs) = mapAccumL add_arg (fun_ty,here_fvs0) ann_args + here_fvs0 = case ann_fun of (_, AnnVar _) -> fun_fvs _ -> emptyDVarSet -- Don't float the binding for f into f x y z; see Note [Join points] @@ -200,15 +208,13 @@ fiExpr platform to_drop ann_expr@(_,AnnApp {}) -- join point, floating it in isn't especially harmful but it's -- useless since the simplifier will immediately float it back out.) - add_arg :: (Type,FreeVarSet) -> CoreExprWithFVs -> (Type,FreeVarSet) - add_arg (fun_ty, extra_fvs) (_, AnnType ty) - = (piResultTy fun_ty ty, extra_fvs) - - add_arg (fun_ty, extra_fvs) (arg_fvs, arg) - | noFloatIntoArg arg arg_ty - = (res_ty, extra_fvs `unionDVarSet` arg_fvs) - | otherwise - = (res_ty, extra_fvs) + add_arg :: (Type,FreeVarSet) -> CoreExprWithFVs -> ((Type,FreeVarSet),FreeVarSet) + add_arg (fun_ty, here_fvs) (arg_fvs, AnnType ty) + = ((piResultTy fun_ty ty, here_fvs), arg_fvs) + -- We can't float into some arguments, so put them into the here_fvs + add_arg (fun_ty, here_fvs) (arg_fvs, arg) + | noFloatIntoArg arg arg_ty = ((res_ty,here_fvs `unionDVarSet` arg_fvs), emptyDVarSet) + | otherwise = ((res_ty,here_fvs), arg_fvs) where (_, arg_ty, res_ty) = splitFunTy fun_ty @@ -292,7 +298,6 @@ it's non-recursive, so we float only into non-recursive join points.) Urk! if all are tyvars, and we don't float in, we may miss an opportunity to float inside a nested case branch - Note [Floating coercions] ~~~~~~~~~~~~~~~~~~~~~~~~~ We could, in principle, have a coercion binding like @@ -312,6 +317,36 @@ of the types of all the drop points involved. If any of the floaters bind a coercion variable mentioned in any of the types, that binder must be dropped right away. +Note [Shadowing and name capture] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have + let x = y+1 in + case p of + (y:ys) -> ...x... + [] -> blah +It is obviously bogus for FloatIn to transform to + case p of + (y:ys) -> ...(let x = y+1 in x)... + [] -> blah +because the y is captured. This doesn't happen much, because shadowing is +rare, but it did happen in #22662. + +One solution would be to clone as we go. But a simpler one is this: + + at a binding site (like that for (y:ys) above), abandon float-in for + any floating bindings that mention the binders (y, ys in this case) + +We achieve that by calling sepBindsByDropPoint with the binders in +the "used-here" set: + +* In fiExpr (AnnLam ...). For the body there is no need to delete + the lambda-binders from the body_fvs, because any bindings that + mention these binders will be dropped here anyway. + +* In fiExpr (AnnCase ...). Remember to include the case_bndr in the + binders. Again, no need to delete the alt binders from the rhs + free vars, beause any bindings mentioning them will be dropped + here unconditionally. -} fiExpr platform to_drop lam@(_, AnnLam _ _) @@ -320,10 +355,17 @@ fiExpr platform to_drop lam@(_, AnnLam _ _) = wrapFloats to_drop (mkLams bndrs (fiExpr platform [] body)) | otherwise -- Float inside - = mkLams bndrs (fiExpr platform to_drop body) + = wrapFloats drop_here $ + mkLams bndrs (fiExpr platform body_drop body) where (bndrs, body) = collectAnnBndrs lam + body_fvs = freeVarsOf body + + -- Why sepBindsByDropPoint? Because of potential capture + -- See Note [Shadowing and name capture] + (drop_here, [body_drop]) = sepBindsByDropPoint platform False to_drop + (mkDVarSet bndrs) [body_fvs] {- We don't float lets inwards past an SCC. @@ -462,16 +504,16 @@ fiExpr platform to_drop (_, AnnCase scrut case_bndr _ [AnnAlt con alt_bndrs rhs] = wrapFloats shared_binds $ fiExpr platform (case_float : rhs_binds) rhs where - case_float = FB (mkDVarSet (case_bndr : alt_bndrs)) scrut_fvs + case_float = FB all_bndrs scrut_fvs (FloatCase scrut' case_bndr con alt_bndrs) scrut' = fiExpr platform scrut_binds scrut - rhs_fvs = freeVarsOf rhs `delDVarSetList` (case_bndr : alt_bndrs) - scrut_fvs = freeVarsOf scrut + rhs_fvs = freeVarsOf rhs -- No need to delete alt_bndrs + scrut_fvs = freeVarsOf scrut -- See Note [Shadowing and name capture] + all_bndrs = mkDVarSet alt_bndrs `extendDVarSet` case_bndr - [shared_binds, scrut_binds, rhs_binds] - = sepBindsByDropPoint platform False - [scrut_fvs, rhs_fvs] - to_drop + (shared_binds, [scrut_binds, rhs_binds]) + = sepBindsByDropPoint platform False to_drop + all_bndrs [scrut_fvs, rhs_fvs] fiExpr platform to_drop (_, AnnCase scrut case_bndr ty alts) = wrapFloats drop_here1 $ @@ -481,38 +523,42 @@ fiExpr platform to_drop (_, AnnCase scrut case_bndr ty alts) -- use zipWithEqual, we should have length alts_drops_s = length alts where -- Float into the scrut and alts-considered-together just like App - [drop_here1, scrut_drops, alts_drops] - = sepBindsByDropPoint platform False - [scrut_fvs, all_alts_fvs] - to_drop + (drop_here1, [scrut_drops, alts_drops]) + = sepBindsByDropPoint platform False to_drop + all_alt_bndrs [scrut_fvs, all_alt_fvs] + -- all_alt_bndrs: see Note [Shadowing and name capture] -- Float into the alts with the is_case flag set - (drop_here2 : alts_drops_s) - | [ _ ] <- alts = [] : [alts_drops] - | otherwise = sepBindsByDropPoint platform True alts_fvs alts_drops - - scrut_fvs = freeVarsOf scrut - alts_fvs = map alt_fvs alts - all_alts_fvs = unionDVarSets alts_fvs - alt_fvs (AnnAlt _con args rhs) - = foldl' delDVarSet (freeVarsOf rhs) (case_bndr:args) - -- Delete case_bndr and args from free vars of rhs - -- to get free vars of alt + (drop_here2, alts_drops_s) + = sepBindsByDropPoint platform True alts_drops emptyDVarSet alts_fvs + + scrut_fvs = freeVarsOf scrut + + all_alt_bndrs = foldr (unionDVarSet . ann_alt_bndrs) (unitDVarSet case_bndr) alts + ann_alt_bndrs (AnnAlt _ bndrs _) = mkDVarSet bndrs + + alts_fvs :: [DVarSet] + alts_fvs = [freeVarsOf rhs | AnnAlt _ _ rhs <- alts] + -- No need to delete binders + -- See Note [Shadowing and name capture] + + all_alt_fvs :: DVarSet + all_alt_fvs = foldr unionDVarSet (unitDVarSet case_bndr) alts_fvs fi_alt to_drop (AnnAlt con args rhs) = Alt con args (fiExpr platform to_drop rhs) ------------------ fiBind :: Platform - -> FloatInBinds -- Binds we're trying to drop - -- as far "inwards" as possible - -> CoreBindWithFVs -- Input binding - -> DVarSet -- Free in scope of binding - -> ( FloatInBinds -- Land these before - , FloatInBind -- The binding itself - , FloatInBinds) -- Land these after + -> RevFloatInBinds -- Binds we're trying to drop + -- as far "inwards" as possible + -> CoreBindWithFVs -- Input binding + -> DVarSet -- Free in scope of binding + -> ( RevFloatInBinds -- Land these before + , FloatInBind -- The binding itself + , RevFloatInBinds) -- Land these after fiBind platform to_drop (AnnNonRec id ann_rhs@(rhs_fvs, rhs)) body_fvs - = ( extra_binds ++ shared_binds -- Land these before + = ( shared_binds -- Land these before -- See Note [extra_fvs (1,2)] , FB (unitDVarSet id) rhs_fvs' -- The new binding itself (FloatLet (NonRec id rhs')) @@ -531,10 +577,9 @@ fiBind platform to_drop (AnnNonRec id ann_rhs@(rhs_fvs, rhs)) body_fvs -- We *can't* float into ok-for-speculation unlifted RHSs -- But do float into join points - [shared_binds, extra_binds, rhs_binds, body_binds] - = sepBindsByDropPoint platform False - [extra_fvs, rhs_fvs, body_fvs2] - to_drop + (shared_binds, [rhs_binds, body_binds]) + = sepBindsByDropPoint platform False to_drop + extra_fvs [rhs_fvs, body_fvs2] -- Push rhs_binds into the right hand side of the binding rhs' = fiRhs platform rhs_binds id ann_rhs @@ -542,7 +587,7 @@ fiBind platform to_drop (AnnNonRec id ann_rhs@(rhs_fvs, rhs)) body_fvs -- Don't forget the rule_fvs; the binding mentions them! fiBind platform to_drop (AnnRec bindings) body_fvs - = ( extra_binds ++ shared_binds + = ( shared_binds , FB (mkDVarSet ids) rhs_fvs' (FloatLet (Rec (fi_bind rhss_binds bindings))) , body_binds ) @@ -556,17 +601,16 @@ fiBind platform to_drop (AnnRec bindings) body_fvs unionDVarSets [ rhs_fvs | (bndr, (rhs_fvs, rhs)) <- bindings , noFloatIntoRhs Recursive bndr rhs ] - (shared_binds:extra_binds:body_binds:rhss_binds) - = sepBindsByDropPoint platform False - (extra_fvs:body_fvs:rhss_fvs) - to_drop + (shared_binds, body_binds:rhss_binds) + = sepBindsByDropPoint platform False to_drop + extra_fvs (body_fvs:rhss_fvs) rhs_fvs' = unionDVarSets rhss_fvs `unionDVarSet` unionDVarSets (map floatedBindsFVs rhss_binds) `unionDVarSet` rule_fvs -- Don't forget the rule variables! -- Push rhs_binds into the right hand side of the binding - fi_bind :: [FloatInBinds] -- one per "drop pt" conjured w/ fvs_of_rhss + fi_bind :: [RevFloatInBinds] -- One per "drop pt" conjured w/ fvs_of_rhss -> [(Id, CoreExprWithFVs)] -> [(Id, CoreExpr)] @@ -575,7 +619,7 @@ fiBind platform to_drop (AnnRec bindings) body_fvs | ((binder, rhs), to_drop) <- zipEqual "fi_bind" pairs to_drops ] ------------------ -fiRhs :: Platform -> FloatInBinds -> CoreBndr -> CoreExprWithFVs -> CoreExpr +fiRhs :: Platform -> RevFloatInBinds -> CoreBndr -> CoreExprWithFVs -> CoreExpr fiRhs platform to_drop bndr rhs | Just join_arity <- isJoinId_maybe bndr , let (bndrs, body) = collectNAnnBndrs join_arity rhs @@ -675,68 +719,84 @@ point. We have to maintain the order on these drop-point-related lists. -} --- pprFIB :: FloatInBinds -> SDoc +-- pprFIB :: RevFloatInBinds -> SDoc -- pprFIB fibs = text "FIB:" <+> ppr [b | FB _ _ b <- fibs] sepBindsByDropPoint :: Platform - -> Bool -- True <=> is case expression - -> [FreeVarSet] -- One set of FVs per drop point - -- Always at least two long! - -> FloatInBinds -- Candidate floaters - -> [FloatInBinds] -- FIRST one is bindings which must not be floated - -- inside any drop point; the rest correspond - -- one-to-one with the input list of FV sets + -> Bool -- True <=> is case expression + -> RevFloatInBinds -- Candidate floaters + -> FreeVarSet -- here_fvs: if these vars are free in a binding, + -- don't float that binding inside any drop point + -> [FreeVarSet] -- fork_fvs: one set of FVs per drop point + -> ( RevFloatInBinds -- Bindings which must not be floated inside + , [RevFloatInBinds] ) -- Corresponds 1-1 with the input list of FV sets -- Every input floater is returned somewhere in the result; -- none are dropped, not even ones which don't seem to be -- free in *any* of the drop-point fvs. Why? Because, for example, -- a binding (let x = E in B) might have a specialised version of -- x (say x') stored inside x, but x' isn't free in E or B. +-- +-- The here_fvs argument is used for two things: +-- * Avoid shadowing bugs: see Note [Shadowing and name capture] +-- * Drop some of the bindings at the top, e.g. of an application type DropBox = (FreeVarSet, FloatInBinds) -sepBindsByDropPoint platform is_case drop_pts floaters +dropBoxFloats :: DropBox -> RevFloatInBinds +dropBoxFloats (_, floats) = reverse floats + +usedInDropBox :: DIdSet -> DropBox -> Bool +usedInDropBox bndrs (db_fvs, _) = db_fvs `intersectsDVarSet` bndrs + +initDropBox :: DVarSet -> DropBox +initDropBox fvs = (fvs, []) + +sepBindsByDropPoint platform is_case floaters here_fvs fork_fvs | null floaters -- Shortcut common case - = [] : [[] | _ <- drop_pts] + = ([], [[] | _ <- fork_fvs]) | otherwise - = ASSERT( drop_pts `lengthAtLeast` 2 ) - go floaters (map (\fvs -> (fvs, [])) (emptyDVarSet : drop_pts)) + = go floaters (initDropBox here_fvs) (map initDropBox fork_fvs) where - n_alts = length drop_pts + n_alts = length fork_fvs - go :: FloatInBinds -> [DropBox] -> [FloatInBinds] - -- The *first* one in the argument list is the drop_here set - -- The FloatInBinds in the lists are in the reverse of - -- the normal FloatInBinds order; that is, they are the right way round! + go :: RevFloatInBinds -> DropBox -> [DropBox] + -> (RevFloatInBinds, [RevFloatInBinds]) + -- The *first* one in the pair is the drop_here set - go [] drop_boxes = map (reverse . snd) drop_boxes + go [] here_box fork_boxes + = (dropBoxFloats here_box, map dropBoxFloats fork_boxes) - go (bind_w_fvs@(FB bndrs bind_fvs bind) : binds) drop_boxes@(here_box : fork_boxes) - = go binds new_boxes + go (bind_w_fvs@(FB bndrs bind_fvs bind) : binds) here_box fork_boxes + | drop_here = go binds (insert here_box) fork_boxes + | otherwise = go binds here_box new_fork_boxes where -- "here" means the group of bindings dropped at the top of the fork - (used_here : used_in_flags) = [ fvs `intersectsDVarSet` bndrs - | (fvs, _) <- drop_boxes] + used_here = bndrs `usedInDropBox` here_box + used_in_flags = case fork_boxes of + [] -> [] + [_] -> [True] -- Push all bindings into a single branch + -- No need to look at its free vars + _ -> map (bndrs `usedInDropBox`) fork_boxes + -- Short-cut for the singleton case; + -- used for lambdas and singleton cases drop_here = used_here || cant_push n_used_alts = count id used_in_flags -- returns number of Trues in list. cant_push - | is_case = n_used_alts == n_alts -- Used in all, don't push - -- Remember n_alts > 1 + | is_case = (n_alts > 1 && n_used_alts == n_alts) + -- Used in all, muliple branches, don't push || (n_used_alts > 1 && not (floatIsDupable platform bind)) -- floatIsDupable: see Note [Duplicating floats] | otherwise = floatIsCase bind || n_used_alts > 1 -- floatIsCase: see Note [Floating primops] - new_boxes | drop_here = (insert here_box : fork_boxes) - | otherwise = (here_box : new_fork_boxes) - new_fork_boxes = zipWithEqual "FloatIn.sepBinds" insert_maybe fork_boxes used_in_flags @@ -746,8 +806,6 @@ sepBindsByDropPoint platform is_case drop_pts floaters insert_maybe box True = insert box insert_maybe box False = box - go _ _ = panic "sepBindsByDropPoint/go" - {- Note [Duplicating floats] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -765,14 +823,14 @@ If the thing is used in all RHSs there is nothing gained, so we don't duplicate then. -} -floatedBindsFVs :: FloatInBinds -> FreeVarSet +floatedBindsFVs :: RevFloatInBinds -> FreeVarSet floatedBindsFVs binds = mapUnionDVarSet fbFVs binds fbFVs :: FloatInBind -> DVarSet fbFVs (FB _ fvs _) = fvs -wrapFloats :: FloatInBinds -> CoreExpr -> CoreExpr --- Remember FloatInBinds is in *reverse* dependency order +wrapFloats :: RevFloatInBinds -> CoreExpr -> CoreExpr +-- Remember RevFloatInBinds is in *reverse* dependency order wrapFloats [] e = e wrapFloats (FB _ _ fl : bs) e = wrapFloats bs (wrapFloat fl e) ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -1283,19 +1283,18 @@ checkSafeImports tcg_env -- restore old errors logWarnings oldErrs - case (isEmptyBag safeErrs) of - -- Failed safe check - False -> liftIO . throwIO . mkSrcErr $ safeErrs - - -- Passed safe check - True -> do - let infPassed = isEmptyBag infErrs - tcg_env' <- case (not infPassed) of - True -> markUnsafeInfer tcg_env infErrs - False -> return tcg_env - when (packageTrustOn dflags) $ checkPkgTrust pkgReqs - let newTrust = pkgTrustReqs dflags safePkgs infPkgs infPassed - return tcg_env' { tcg_imports = impInfo `plusImportAvails` newTrust } + logger <- getLogger + -- Will throw if failed safe check + liftIO $ printOrThrowWarnings logger dflags safeErrs + + -- No fatal warnings or errors: passed safe check + let infPassed = isEmptyBag infErrs + tcg_env' <- case (not infPassed) of + True -> markUnsafeInfer tcg_env infErrs + False -> return tcg_env + when (packageTrustOn dflags) $ checkPkgTrust pkgReqs + let newTrust = pkgTrustReqs dflags safePkgs infPkgs infPassed + return tcg_env' { tcg_imports = impInfo `plusImportAvails` newTrust } where impInfo = tcg_imports tcg_env -- ImportAvails ===================================== docs/users_guide/bugs.rst ===================================== @@ -546,6 +546,15 @@ them will be fixed in the short term. Bugs in GHC ~~~~~~~~~~~ +- `readIORef` from `Data.IORef` is missing memory barriers and might + result in inconsistent or unsafe behaviour on architectures with weaker + memory models such as AArch64. See :ghc-ticket:`22468` for more details. + +- `isByteArrayPinned#` considers large `ByteArray#`s pinned, even if they + were not explicitly pinned. This can be incorrect if the `ByteArray#` is + subsequently added to a compact region as the `ByteArray#` will be moved + in the process. See :ghc-ticket:`22255` for more details. + - GHC's runtime system implements cooperative multitasking, with context switching potentially occurring only when a program allocates. This means that programs that do not allocate may never ===================================== libraries/bytestring ===================================== @@ -1 +1 @@ -Subproject commit 1543e054a314865d89a259065921d5acba03d966 +Subproject commit 9cab76dc861f651c3940e873ce921d9e09733cc8 ===================================== libraries/ghc-bignum/gmp/gmp-tarballs ===================================== @@ -1 +1 @@ -Subproject commit 31f9909680ba8fe00d27fd8a6f5d198a0a96c1ac +Subproject commit 4f26049af40afb380eaf033ab91404cd2e214919 ===================================== rts/Sparks.c ===================================== @@ -79,6 +79,34 @@ newSpark (StgRegTable *reg, StgClosure *p) return 1; } +/* Note [Pruning the spark pool] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +pruneSparkQueue checks if closures have been evacuated to know weither or +not a spark can be GCed. If it was evacuated it's live and we keep the spark +alive. If it hasn't been evacuated at the end of GC we can assume it's dead and +remove the spark from the pool. + +To make this sound we must ensure GC has finished evacuating live objects before +we prune the spark pool. Otherwise we might GC a spark before it has been evaluated. + +* If we run sequential GC then the GC Lead simply prunes after +everything has been evacuated. + +* If we run parallel gc without work stealing then GC workers are not synchronized +at any point before the worker returns. So we leave it to the GC Lead to prune +sparks once evacuation has been finished and all workers returned. + +* If work stealing is enabled all GC threads will be running +scavenge_until_all_done until regular heap marking is done. After which +all workers will converge on a synchronization point. This means +we can perform spark pruning inside the GC workers at this point. +The only wart is that if we prune sparks locally we might +miss sparks reachable via weak pointers as these are marked in the main +thread concurrently to the calls to pruneSparkQueue. To fix this problem would +require a GC barrier but that seems to high a price to pay. +*/ + + /* -------------------------------------------------------------------------- * Remove all sparks from the spark queues which should not spark any * more. Called after GC. We assume exclusive access to the structure @@ -181,7 +209,7 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap) cap->spark_stats.fizzled++; traceEventSparkFizzle(cap); } else { - info = spark->header.info; + info = RELAXED_LOAD(&spark->header.info); load_load_barrier(); if (IS_FORWARDING_PTR(info)) { tmp = (StgClosure*)UN_FORWARDING_PTR(info); ===================================== rts/eventlog/EventLog.c ===================================== @@ -1074,7 +1074,17 @@ void postCapsetVecEvent (EventTypeNum tag, for (int i = 0; i < argc; i++) { // 1 + strlen to account for the trailing \0, used as separator - size += 1 + strlen(argv[i]); + int increment = 1 + strlen(argv[i]); + if (size + increment > EVENT_PAYLOAD_SIZE_MAX) { + errorBelch("Event size exceeds EVENT_PAYLOAD_SIZE_MAX, record only %" + FMT_Int " out of %" FMT_Int " args", + (long long) i, + (long long) argc); + argc = i; + break; + } else { + size += increment; + } } ACQUIRE_LOCK(&eventBufMutex); ===================================== rts/sm/GC.c ===================================== @@ -291,6 +291,7 @@ GarbageCollect (uint32_t collect_gen, any_work, scav_find_work, max_n_todo_overflow; #if defined(THREADED_RTS) gc_thread *saved_gct; + bool gc_sparks_all_caps; #endif uint32_t g, n; // The time we should report our heap census as occurring at, if necessary. @@ -555,6 +556,9 @@ GarbageCollect (uint32_t collect_gen, StgTSO *resurrected_threads = END_TSO_QUEUE; // must be last... invariant is that everything is fully // scavenged at this point. +#if defined(THREADED_RTS) + gc_sparks_all_caps = !work_stealing || !is_par_gc(); +#endif work_stealing = false; while (traverseWeakPtrList(&dead_weak_ptr_list, &resurrected_threads)) { @@ -567,6 +571,7 @@ GarbageCollect (uint32_t collect_gen, gcStableNameTable(); #if defined(THREADED_RTS) + // See Note [Pruning the spark pool] if (!is_par_gc()) { for (n = 0; n < n_capabilities; n++) { pruneSparkQueue(false, capabilities[n]); @@ -1371,7 +1376,6 @@ void gcWorkerThread (Capability *cap) { gc_thread *saved_gct; - // necessary if we stole a callee-saves register for gct: saved_gct = gct; @@ -1402,13 +1406,10 @@ gcWorkerThread (Capability *cap) scavenge_until_all_done(); #if defined(THREADED_RTS) - // Now that the whole heap is marked, we discard any sparks that - // were found to be unreachable. The main GC thread is currently - // marking heap reachable via weak pointers, so it is - // non-deterministic whether a spark will be retained if it is - // only reachable via weak pointers. To fix this problem would - // require another GC barrier, which is too high a price. - pruneSparkQueue(false, cap); + // See Note [Pruning the spark pool] + if(work_stealing && is_par_gc()) { + pruneSparkQueue(false, cap); + } #endif // Wait until we're told to continue ===================================== testsuite/tests/safeHaskell/warnings/Makefile ===================================== @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk ===================================== testsuite/tests/safeHaskell/warnings/T22728.hs ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE Safe #-} +{-# LANGUAGE Haskell2010 #-} +{-# OPTIONS_GHC -Winferred-safe-imports #-} +module T22728 (module T22728_B) where + +import T22728_B ===================================== testsuite/tests/safeHaskell/warnings/T22728.stderr ===================================== @@ -0,0 +1,4 @@ +[2 of 2] Compiling T22728 ( T22728.hs, T22728.o ) + +T22728.hs:6:1: warning: [GHC-82658] [-Winferred-safe-imports] + Importing Safe-Inferred module T22728_B from explicitly Safe module ===================================== testsuite/tests/safeHaskell/warnings/T22728_B.hs ===================================== @@ -0,0 +1,6 @@ +-- inferred safe +{-# LANGUAGE Haskell2010 #-} +module T22728_B where + +int :: Int +int = 3 ===================================== testsuite/tests/safeHaskell/warnings/T22728b.hs ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE Safe #-} +{-# LANGUAGE Haskell2010 #-} +{-# OPTIONS_GHC -Werror=inferred-safe-imports #-} +module T22728b (module T22728b_B) where + +import T22728b_B ===================================== testsuite/tests/safeHaskell/warnings/T22728b.stderr ===================================== @@ -0,0 +1,4 @@ +[2 of 2] Compiling T22728b ( T22728b.hs, T22728b.o ) + +T22728b.hs:6:1: error: [GHC-82658] [-Winferred-safe-imports, Werror=inferred-safe-imports] + Importing Safe-Inferred module T22728b_B from explicitly Safe module ===================================== testsuite/tests/safeHaskell/warnings/T22728b_B.hs ===================================== @@ -0,0 +1,6 @@ +-- inferred safe +{-# LANGUAGE Haskell2010 #-} +module T22728b_B where + +int :: Int +int = 3 ===================================== testsuite/tests/safeHaskell/warnings/all.T ===================================== @@ -0,0 +1,2 @@ +test('T22728', normal, multi_compile, ['T22728.hs', [('T22728_B.hs', '')], '']) +test('T22728b', normal, multi_compile_fail, ['T22728b.hs', [('T22728b_B.hs', '')], '']) ===================================== testsuite/tests/simplCore/should_compile/T22662.hs ===================================== @@ -0,0 +1,6 @@ +module T22662 where + +import Data.Set + +foo x = sequence_ [ f y | y <- x ] + where f _ = return (fromList [0]) ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -366,3 +366,4 @@ test('T20200', normal, compile, ['']) # which (before the fix) lost crucial dependencies test('T20820', normal, compile, ['-O0']) test('T22491', normal, compile, ['-O2']) +test('T22662', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8164d9d7839d184f599376e89deb05cc493244c8...e50494f5489ebc7049a892829b78cf8bac2df6b6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8164d9d7839d184f599376e89deb05cc493244c8...e50494f5489ebc7049a892829b78cf8bac2df6b6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 1 09:51:41 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 01 Feb 2023 04:51:41 -0500 Subject: [Git][ghc/ghc][wip/disable-iface-sharing] Disable unfolding sharing for interface files with core definitions Message-ID: <63da362d8b880_2a4fa049e4412598f7@gitlab.mail> Matthew Pickering pushed to branch wip/disable-iface-sharing at Glasgow Haskell Compiler / GHC Commits: a060fa30 by Matthew Pickering at 2023-02-01T09:51:14+00:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 10 changed files: - compiler/GHC/CoreToIface.hs - compiler/GHC/IfaceToCore.hs - testsuite/tests/driver/fat-iface/Makefile - + testsuite/tests/driver/fat-iface/T22807.stdout - + testsuite/tests/driver/fat-iface/T22807A.hs - + testsuite/tests/driver/fat-iface/T22807B.hs - + testsuite/tests/driver/fat-iface/T22807_ghci.hs - + testsuite/tests/driver/fat-iface/T22807_ghci.script - + testsuite/tests/driver/fat-iface/T22807_ghci.stdout - testsuite/tests/driver/fat-iface/all.T Changes: ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -604,8 +604,12 @@ toIfaceTopBind b = IfLclTopBndr {} -> IfRhs (toIfaceExpr rhs) in (top_bndr, rhs') - already_has_unfolding b = - -- The identifier has an unfolding, which we are going to serialise anyway + -- The sharing behaviour is currently disabled due to #22807, and relies on + -- finished #220056 to be re-enabled. + disabledDueTo22807 = True + + already_has_unfolding b = not disabledDueTo22807 + && -- The identifier has an unfolding, which we are going to serialise anyway hasCoreUnfolding (realIdUnfolding b) -- But not a stable unfolding, we want the optimised unfoldings. && not (isStableUnfolding (realIdUnfolding b)) @@ -771,7 +775,10 @@ is that these NOINLINE'd functions now can't be profitably inlined outside of the hs-boot loop. Note [Interface File with Core: Sharing RHSs] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +IMPORTANT: This optimisation is currently disabled due to #22027, it can be + re-enabled once #220056 is implemented. In order to avoid duplicating definitions for bindings which already have unfoldings we do some minor headstands to avoid serialising the RHS of a definition if it has ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -933,7 +933,13 @@ tc_iface_bindings (IfaceRec bs) = do -- | See Note [Interface File with Core: Sharing RHSs] tc_iface_binding :: Id -> IfaceMaybeRhs -> IfL CoreExpr -tc_iface_binding i IfUseUnfoldingRhs = return (unfoldingTemplate $ realIdUnfolding i) +tc_iface_binding i IfUseUnfoldingRhs = + case maybeUnfoldingTemplate $ realIdUnfolding i of + Just e -> return e + Nothing -> pprPanic "tc_iface_binding" (vcat [text "Binding" <+> quotes (ppr i) <+> text "had an unfolding when the interface file was created" + , text "which has now gone missing, something has badly gone wrong." + , text "Unfolding:" <+> ppr (realIdUnfolding i)]) + tc_iface_binding _ (IfRhs rhs) = tcIfaceExpr rhs mk_top_id :: IfaceTopBndrInfo -> IfL Id ===================================== testsuite/tests/driver/fat-iface/Makefile ===================================== @@ -49,4 +49,11 @@ fat010: clean echo >> "THB.hs" "$(TEST_HC)" $(TEST_HC_OPTS) THC.hs -fhide-source-paths -fwrite-if-simplified-core -fprefer-byte-code +T22807: clean + "$(TEST_HC)" $(TEST_HC_OPTS) T22807A.hs -fhide-source-paths -fwrite-if-simplified-core -fbyte-code-and-object-code -fno-omit-interface-pragmas -fprefer-byte-code + "$(TEST_HC)" $(TEST_HC_OPTS) T22807B.hs -fhide-source-paths -fwrite-if-simplified-core -fprefer-byte-code -fbyte-code-and-object-code -fno-omit-interface-pragmas + +T22807_ghci: clean + "$(TEST_HC)" $(TEST_HC_OPTS) T22807_ghci.hs -fno-full-laziness -fhide-source-paths -fwrite-if-simplified-core -O2 -dynamic -v0 + "$(TEST_HC)" $(TEST_HC_OPTS) -v0 --interactive -fhide-source-paths -fno-full-laziness < T22807_ghci.script ===================================== testsuite/tests/driver/fat-iface/T22807.stdout ===================================== @@ -0,0 +1,2 @@ +[1 of 1] Compiling T22807A +[2 of 2] Compiling T22807B ===================================== testsuite/tests/driver/fat-iface/T22807A.hs ===================================== @@ -0,0 +1,6 @@ +module T22807A where + +xs :: [a] +xs = [] + + ===================================== testsuite/tests/driver/fat-iface/T22807B.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE TemplateHaskell #-} +module T22807B where +import T22807A + +$(pure xs) ===================================== testsuite/tests/driver/fat-iface/T22807_ghci.hs ===================================== @@ -0,0 +1,8 @@ +module T22807_ghci where + + +foo b = + let x = Just [1..1000] + in if b + then Left x + else Right x ===================================== testsuite/tests/driver/fat-iface/T22807_ghci.script ===================================== @@ -0,0 +1,6 @@ +:l T22807_ghci.hs + +import T22807_ghci +import Data.Either + +isLeft (foo True) ===================================== testsuite/tests/driver/fat-iface/T22807_ghci.stdout ===================================== @@ -0,0 +1 @@ +True ===================================== testsuite/tests/driver/fat-iface/all.T ===================================== @@ -15,5 +15,9 @@ test('fat013', [req_th, extra_files(['FatTH.hs', 'FatQuote.hs'])], multimod_comp # When using interpreter should not produce objects test('fat014', [req_th, extra_files(['FatTH.hs', 'FatQuote.hs']), extra_run_opts('-fno-code')], ghci_script, ['fat014.script']) test('fat015', [req_th, unless(ghc_dynamic(), skip), extra_files(['FatQuote.hs', 'FatQuote1.hs', 'FatQuote2.hs', 'FatTH1.hs', 'FatTH2.hs', 'FatTHTop.hs'])], multimod_compile, ['FatTHTop', '-fno-code -fwrite-interface']) +test('T22807', [req_th, unless(ghc_dynamic(), skip), extra_files(['T22807A.hs', 'T22807B.hs'])] + , makefile_test, ['T22807']) +test('T22807_ghci', [req_th, unless(ghc_dynamic(), skip), extra_files(['T22807_ghci.hs'])] + , makefile_test, ['T22807_ghci']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a060fa30a2149aa498d847ce441ac696b1ed04d5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a060fa30a2149aa498d847ce441ac696b1ed04d5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 1 10:25:34 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 01 Feb 2023 05:25:34 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/remove-trace-stg Message-ID: <63da3e1eeecd1_2a4fc0778d812712e9@gitlab.mail> Matthew Pickering pushed new branch wip/remove-trace-stg at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/remove-trace-stg You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 1 11:08:25 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 01 Feb 2023 06:08:25 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/mp-backports-9.6 Message-ID: <63da4829bf167_2a4f3b9c710c12849d3@gitlab.mail> Matthew Pickering pushed new branch wip/mp-backports-9.6 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/mp-backports-9.6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 1 11:55:26 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Wed, 01 Feb 2023 06:55:26 -0500 Subject: [Git][ghc/ghc][wip/9.2.6-backports] 3 commits: Fix an assertion check in addToEqualCtList Message-ID: <63da532eb0d26_2a4f55f5013116d6@gitlab.mail> Zubin pushed to branch wip/9.2.6-backports at Glasgow Haskell Compiler / GHC Commits: 346886bf by Simon Peyton Jones at 2023-02-01T16:00:06+05:30 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 (cherry picked from commit 3d55d8ab51ece43c51055c43c9e7aba77cce46c0) - - - - - bd5ace54 by Simon Peyton Jones at 2023-02-01T16:36:28+05:30 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. (cherry picked from commit e193e53790dd5886feea3cf4c9c17625d188291b) - - - - - e311168e by Sebastian Graf at 2023-02-01T17:24:19+05:30 DmdAnal: Don't panic in addCaseBndrDmd (#22039) Rather conservatively return Top. See Note [Untyped demand on case-alternative binders]. I also factored `addCaseBndrDmd` into two separate functions `scrutSubDmd` and `fieldBndrDmds`. Fixes #22039. (cherry picked from commit d2be80fd9b222963e8dd09a30f78c106e00da7f9) - - - - - 10 changed files: - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/OccurAnal.hs - + testsuite/tests/simplCore/should_compile/T22623.hs - + testsuite/tests/simplCore/should_compile/T22623a.hs - testsuite/tests/simplCore/should_compile/all.T - + testsuite/tests/stranal/should_compile/T22039.hs - testsuite/tests/stranal/should_compile/all.T - + testsuite/tests/typecheck/should_fail/T22645.hs - + testsuite/tests/typecheck/should_fail/T22645.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -439,10 +439,11 @@ dmdAnal' env dmd (Case scrut case_bndr ty [Alt alt bndrs rhs]) -- whole DmdEnv !(!bndrs', !scrut_sd) | DataAlt _ <- alt - , id_dmds <- addCaseBndrDmd case_bndr_sd dmds - -- See Note [Demand on scrutinee of a product case] - = let !new_info = setBndrsDemandInfo bndrs id_dmds - !new_prod = mkProd id_dmds + -- See Note [Demand on the scrutinee of a product case] + , let !scrut_sd = scrutSubDmd case_bndr_sd dmds + , let !fld_dmds' = fieldBndrDmds scrut_sd (length dmds) + = let !new_info = setBndrsDemandInfo bndrs fld_dmds' + !new_prod = mkProd fld_dmds' in (new_info, new_prod) | otherwise -- __DEFAULT and literal alts. Simply add demands and discard the @@ -556,11 +557,32 @@ dmdAnalSumAlt env dmd case_bndr (Alt con bndrs rhs) , WithDmdType rhs_ty rhs' <- dmdAnal rhs_env dmd rhs , WithDmdType alt_ty dmds <- findBndrsDmds env rhs_ty bndrs , let (_ :* case_bndr_sd) = findIdDemand alt_ty case_bndr - -- See Note [Demand on scrutinee of a product case] - id_dmds = addCaseBndrDmd case_bndr_sd dmds + -- See Note [Demand on case-alternative binders] + -- we can't use the scrut_sd, because it says 'Prod' and we'll use + -- topSubDmd anyway for scrutinees of sum types. + scrut_sd = scrutSubDmd case_bndr_sd dmds + id_dmds = fieldBndrDmds scrut_sd (length dmds) -- Do not put a thunk into the Alt - !new_ids = setBndrsDemandInfo bndrs id_dmds - = WithDmdType alt_ty (Alt con new_ids rhs') + !new_ids = setBndrsDemandInfo bndrs id_dmds + = -- pprTrace "dmdAnalSumAlt" (ppr con $$ ppr case_bndr $$ ppr dmd $$ ppr alt_ty) $ + WithDmdType alt_ty (Alt con new_ids rhs') + +-- See Note [Demand on the scrutinee of a product case] +scrutSubDmd :: SubDemand -> [Demand] -> SubDemand +scrutSubDmd case_sd fld_dmds = + -- pprTraceWith "scrutSubDmd" (\scrut_sd -> ppr case_sd $$ ppr fld_dmds $$ ppr scrut_sd) $ + case_sd `plusSubDmd` mkProd fld_dmds + +-- See Note [Demand on case-alternative binders] +fieldBndrDmds :: SubDemand -- on the scrutinee + -> Arity + -> [Demand] -- Final demands for the components of the DataCon +fieldBndrDmds scrut_sd n_flds = + case viewProd n_flds scrut_sd of + Just ds -> ds + Nothing -> replicate n_flds topDmd + -- Either an arity mismatch or scrut_sd was a call demand. + -- See Note [Untyped demand on case-alternative binders] {- Note [Analysing with absent demand] @@ -672,6 +694,89 @@ worker, so the worker will rebuild x = (a, absent-error) and that'll crash. +Note [Demand on case-alternative binders] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The demand on a binder in a case alternative comes + (a) From the demand on the binder itself + (b) From the demand on the case binder +Forgetting (b) led directly to #10148. + +Example. Source code: + f x@(p,_) = if p then foo x else True + + foo (p,True) = True + foo (p,q) = foo (q,p) + +After strictness analysis, forgetting (b): + f = \ (x_an1 [Dmd=1P(1L,ML)] :: (Bool, Bool)) -> + case x_an1 + of wild_X7 [Dmd=MP(ML,ML)] + { (p_an2 [Dmd=1L], ds_dnz [Dmd=A]) -> + case p_an2 of _ { + False -> GHC.Types.True; + True -> foo wild_X7 } + +Note that ds_dnz is syntactically dead, but the expression bound to it is +reachable through the case binder wild_X7. Now watch what happens if we inline +foo's wrapper: + f = \ (x_an1 [Dmd=1P(1L,ML)] :: (Bool, Bool)) -> + case x_an1 + of _ [Dmd=MP(ML,ML)] + { (p_an2 [Dmd=1L], ds_dnz [Dmd=A]) -> + case p_an2 of _ { + False -> GHC.Types.True; + True -> $wfoo_soq GHC.Types.True ds_dnz } + +Look at that! ds_dnz has come back to life in the call to $wfoo_soq! A second +run of demand analysis would no longer infer ds_dnz to be absent. +But unlike occurrence analysis, which infers properties of the *syntactic* +shape of the program, the results of demand analysis describe expressions +*semantically* and are supposed to be mostly stable across Simplification. +That's why we should better account for (b). +In #10148, we ended up emitting a single-entry thunk instead of an updateable +thunk for a let binder that was an an absent case-alt binder during DmdAnal. + +This is needed even for non-product types, in case the case-binder +is used but the components of the case alternative are not. + +Note [Untyped demand on case-alternative binders] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +With unsafeCoerce, #8037 and #22039 taught us that the demand on the case binder +may be a call demand or have a different number of fields than the constructor +of the case alternative it is used in. From T22039: + + blarg :: (Int, Int) -> Int + blarg (x,y) = x+y + -- blarg :: <1!P(1L,1L)> + + f :: Either Int Int -> Int + f Left{} = 0 + f e = blarg (unsafeCoerce e) + ==> { desugars to } + f = \ (ds_d1nV :: Either Int Int) -> + case ds_d1nV of wild_X1 { + Left ds_d1oV -> lvl_s1Q6; + Right ipv_s1Pl -> + blarg + (case unsafeEqualityProof @(*) @(Either Int Int) @(Int, Int) of + { UnsafeRefl co_a1oT -> + wild_X1 `cast` (Sub (Sym co_a1oT) :: Either Int Int ~R# (Int, Int)) + }) + } + +The case binder `e`/`wild_X1` has demand 1!P(1L,1L), with two fields, from the call +to `blarg`, but `Right` only has one field. Although the code will crash when +executed, we must be able to analyse it in 'fieldBndrDmds' and conservatively +approximate with Top instead of panicking because of the mismatch. +In #22039, this kind of code was guarded behind a safe `cast` and thus dead +code, but nevertheless led to a panic of the compiler. + +You might wonder why the same problem doesn't come up when scrutinising a +product type instead of a sum type. It appears that for products, `wild_X1` +will be inlined before DmdAnal. + +See also Note [mkWWstr and unsafeCoerce] for a related issue. + Note [Aggregated demand for cardinality] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FIXME: This Note should be named [LetUp vs. LetDown] and probably predates ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -1725,7 +1725,7 @@ occAnalRhs :: OccEnv -> RecFlag -> Maybe JoinArity -> CoreExpr -- RHS -> (UsageDetails, CoreExpr) occAnalRhs env is_rec mb_join_arity rhs - = case occAnalLamOrRhs env bndrs body of { (body_usage, bndrs', body') -> + = case occAnalLamOrRhs env1 bndrs body of { (body_usage, bndrs', body') -> let final_bndrs | isRec is_rec = bndrs' | otherwise = markJoinOneShots mb_join_arity bndrs' -- For a /non-recursive/ join point we can mark all @@ -1737,6 +1737,7 @@ occAnalRhs env is_rec mb_join_arity rhs in (rhs_usage, mkLams final_bndrs body') } where (bndrs, body) = collectBinders rhs + env1 = addInScope env bndrs occAnalUnfolding :: OccEnv -> RecFlag @@ -2005,7 +2006,7 @@ partially applying lambdas. See the calls to zapLamBndrs in occAnal env expr@(Lam _ _) = -- See Note [Occurrence analysis for lambda binders] - case occAnalLamOrRhs env bndrs body of { (usage, tagged_bndrs, body') -> + case occAnalLamOrRhs env1 bndrs body of { (usage, tagged_bndrs, body') -> let expr' = mkLams tagged_bndrs body' usage1 = markAllNonTail usage @@ -2015,6 +2016,7 @@ occAnal env expr@(Lam _ _) (final_usage, expr') } where (bndrs, body) = collectBinders expr + env1 = addInScope env bndrs occAnal env (Case scrut bndr ty alts) = case occAnal (scrutCtxt env alts) scrut of { (scrut_usage, scrut') -> @@ -2284,12 +2286,13 @@ data OccEnv -- See Note [The binder-swap substitution] -- If x :-> (y, co) is in the env, - -- then please replace x by (y |> sym mco) - -- Invariant of course: idType x = exprType (y |> sym mco) - , occ_bs_env :: VarEnv (OutId, MCoercion) - , occ_bs_rng :: VarSet -- Vars free in the range of occ_bs_env + -- then please replace x by (y |> mco) + -- Invariant of course: idType x = exprType (y |> mco) + , occ_bs_env :: !(IdEnv (OutId, MCoercion)) -- Domain is Global and Local Ids -- Range is just Local Ids + , occ_bs_rng :: !VarSet + -- Vars (TyVars and Ids) free in the range of occ_bs_env } @@ -2578,25 +2581,29 @@ Some tricky corners: (BS3) We need care when shadowing. Suppose [x :-> b] is in occ_bs_env, and we encounter: - - \x. blah - Here we want to delete the x-binding from occ_bs_env - - - \b. blah - This is harder: we really want to delete all bindings that - have 'b' free in the range. That is a bit tiresome to implement, - so we compromise. We keep occ_bs_rng, which is the set of - free vars of rng(occc_bs_env). If a binder shadows any of these - variables, we discard all of occ_bs_env. Safe, if a bit - brutal. NB, however: the simplifer de-shadows the code, so the - next time around this won't happen. + (i) \x. blah + Here we want to delete the x-binding from occ_bs_env + + (ii) \b. blah + This is harder: we really want to delete all bindings that + have 'b' free in the range. That is a bit tiresome to implement, + so we compromise. We keep occ_bs_rng, which is the set of + free vars of rng(occc_bs_env). If a binder shadows any of these + variables, we discard all of occ_bs_env. Safe, if a bit + brutal. NB, however: the simplifer de-shadows the code, so the + next time around this won't happen. These checks are implemented in addInScope. - - The occurrence analyser itself does /not/ do cloning. It could, in - principle, but it'd make it a bit more complicated and there is no - great benefit. The simplifer uses cloning to get a no-shadowing - situation, the care-when-shadowing behaviour above isn't needed for - long. + (i) is needed only for Ids, but (ii) is needed for tyvars too (#22623) + because if occ_bs_env has [x :-> ...a...] where `a` is a tyvar, we + must not replace `x` by `...a...` under /\a. ...x..., or similarly + under a case pattern match that binds `a`. + + An alternative would be for the occurrence analyser to do cloning as + it goes. In principle it could do so, but it'd make it a bit more + complicated and there is no great benefit. The simplifer uses + cloning to get a no-shadowing situation, the care-when-shadowing + behaviour above isn't needed for long. (BS4) The domain of occ_bs_env can include GlobaIds. Eg case M.foo of b { alts } ===================================== testsuite/tests/simplCore/should_compile/T22623.hs ===================================== @@ -0,0 +1,34 @@ +{-# LANGUAGE GHC2021 #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module T22623 where + +import T22623a + +type BindNonEmptyList :: NonEmpty -> NonEmpty -> [Q] +type family BindNonEmptyList (x :: NonEmpty) (y :: NonEmpty) :: [Q] where + BindNonEmptyList ('(:|) a as) c = Tail c ++ Foldr2 a c as + +sBindNonEmptyList :: + forall (t :: NonEmpty) + (c :: NonEmpty). SNonEmpty t -> SNonEmpty c -> SList (BindNonEmptyList t c :: [Q]) +sBindNonEmptyList + ((:%|) (sA :: SQ a) (sAs :: SList as)) (sC :: SNonEmpty c) + = let + sMyHead :: SNonEmpty c -> SQ (MyHead a c) + sMyHead ((:%|) x _) = x + + sFoldr :: forall t. SList t -> SList (Foldr2 a c t) + sFoldr SNil = SNil + sFoldr (SCons _ sYs) = SCons (sMyHead sC) (sFoldr sYs) + + sF :: Id (SLambda (ConstSym1 c)) + sF = SLambda (const sC) + + sBs :: SList (Tail c) + _ :%| sBs = applySing sF sA + in + sBs %++ sFoldr sAs ===================================== testsuite/tests/simplCore/should_compile/T22623a.hs ===================================== @@ -0,0 +1,60 @@ +{-# LANGUAGE GHC2021 #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +module T22623a where + +import Data.Kind + +type Id :: Type -> Type +type family Id x +type instance Id x = x + +data Q +data SQ (x :: Q) + +data NonEmpty where + (:|) :: Q -> [Q] -> NonEmpty + +type Tail :: NonEmpty -> [Q] +type family Tail y where + Tail ('(:|) _ y) = y +type MyHead :: Q -> NonEmpty -> Q +type family MyHead x y where + MyHead _ ('(:|) c _) = c + +type SList :: [Q] -> Type +data SList z where + SNil :: SList '[] + SCons :: SQ x -> SList xs -> SList (x:xs) + +type SNonEmpty :: NonEmpty -> Type +data SNonEmpty z where + (:%|) :: SQ x -> SList xs -> SNonEmpty (x :| xs) + +data TyFun +type F = TyFun -> Type + +type Apply :: F -> Q -> NonEmpty +type family Apply f x + +type ConstSym1 :: NonEmpty -> F +data ConstSym1 (x :: NonEmpty) :: F +type instance Apply (ConstSym1 x) _ = x + +type SLambda :: F -> Type +newtype SLambda (f :: F) = + SLambda { applySing :: forall t. SQ t -> SNonEmpty (f `Apply` t) } + +type Foldr2 :: Q -> NonEmpty -> [Q] -> [Q] +type family Foldr2 a c x where + Foldr2 _ _ '[] = '[] + Foldr2 a c (_:ys) = MyHead a c : Foldr2 a c ys + +type (++) :: [Q] -> [Q] -> [Q] +type family (++) xs ys where + (++) '[] ys = ys + (++) ('(:) x xs) ys = '(:) x (xs ++ ys) + +(%++) :: forall (x :: [Q]) (y :: [Q]). SList x -> SList y -> SList (x ++ y) +(%++) SNil sYs = sYs +(%++) (SCons sX sXs) sYs = SCons sX (sXs %++ sYs) ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -367,3 +367,4 @@ test('T20200', normal, compile, ['']) test('T20820', normal, compile, ['-O0']) test('T22491', normal, compile, ['-O2']) test('T22662', normal, compile, ['']) +test('T22623', normal, multimod_compile, ['T22623', '-O -v0']) ===================================== testsuite/tests/stranal/should_compile/T22039.hs ===================================== @@ -0,0 +1,59 @@ +{-# LANGUAGE ExistentialQuantification #-} + +module Bug where + +import Control.Exception +import Data.Typeable +import Unsafe.Coerce + +data Error + = Error Int String + | forall e . Exception e => SomeError Int e + deriving (Typeable) + +fromError :: Exception e => Error -> Maybe e +fromError e@(Error _ _) = cast e +fromError (SomeError _ e) = cast e +-- {-# NOINLINE fromError #-} + +instance Eq Error where + Error i s == Error i' s' = i == i' && s == s' + SomeError i e == SomeError i' e' = i == i' && show e == show e' + _ == _ = False + +instance Show Error where + show _ = "" + +instance Exception Error + +-- newtype +data + UniquenessError = UniquenessError [((String, String), Int)] + deriving (Show, Eq) + +instance Exception UniquenessError + +test :: SomeException -> IO () +test e = case fromError =<< fromException e :: Maybe UniquenessError of + Just err -> print err + _ -> pure () + +-- +-- Smaller reproducer by sgraf +-- + +blarg :: (Int,Int) -> Int +blarg (x,y) = x+y +{-# NOINLINE blarg #-} + +f :: Either Int Int -> Int +f Left{} = 0 +f e = blarg (unsafeCoerce e) + +blurg :: (Int -> Int) -> Int +blurg f = f 42 +{-# NOINLINE blurg #-} + +g :: Either Int Int -> Int +g Left{} = 0 +g e = blurg (unsafeCoerce e) ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -69,3 +69,4 @@ test('T20663', [ grep_errmsg(r'\$wyeah ::') ], compile, ['-dppr-cols=1000 -ddump test('T19180', normal, compile, ['']) test('T19849', normal, compile, ['']) +test('T22039', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T22645.hs ===================================== @@ -0,0 +1,9 @@ +module T22645 where + +import Data.Coerce + +type T :: (* -> *) -> * -> * +data T m a = MkT (m a) + +p :: Coercible a b => T Maybe a -> T Maybe b +p = coerce ===================================== testsuite/tests/typecheck/should_fail/T22645.stderr ===================================== @@ -0,0 +1,15 @@ + +T22645.hs:9:5: error: [GHC-25897] + • Couldn't match type ‘a’ with ‘b’ arising from a use of ‘coerce’ + ‘a’ is a rigid type variable bound by + the type signature for: + p :: forall a b. Coercible a b => T Maybe a -> T Maybe b + at T22645.hs:8:1-44 + ‘b’ is a rigid type variable bound by + the type signature for: + p :: forall a b. Coercible a b => T Maybe a -> T Maybe b + at T22645.hs:8:1-44 + • In the expression: coerce + In an equation for ‘p’: p = coerce + • Relevant bindings include + p :: T Maybe a -> T Maybe b (bound at T22645.hs:9:1) ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -629,3 +629,4 @@ test('T19397E4', extra_files(['T19397S.hs']), multimod_compile_fail, test('T20043', normal, compile_fail, ['']) test('T20260', normal, compile_fail, ['']) test('T21130', normal, compile_fail, ['']) +test('T22645', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e50494f5489ebc7049a892829b78cf8bac2df6b6...e311168e37f5196614d04709b6e48f9a7f3c83d4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e50494f5489ebc7049a892829b78cf8bac2df6b6...e311168e37f5196614d04709b6e48f9a7f3c83d4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 1 12:50:52 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 01 Feb 2023 07:50:52 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Bump transformers submodule to 0.6.0.6 Message-ID: <63da602c82058_2a4f23b2f78c13289e7@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - e739c68c by Simon Peyton Jones at 2023-02-01T07:50:38-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - d97009fc by Matthew Pickering at 2023-02-01T07:50:38-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - 407703c3 by Matthew Pickering at 2023-02-01T07:50:38-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 23 changed files: - .gitlab-ci.yml - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Wasm/ControlFlow/FromCmm.hs - configure.ac - libraries/transformers - llvm-passes - + testsuite/tests/cmm/should_run/T22871.hs - + testsuite/tests/cmm/should_run/T22871.stdout - + testsuite/tests/cmm/should_run/T22871_cmm.cmm - testsuite/tests/cmm/should_run/all.T - + testsuite/tests/gadt/T19847.hs - + testsuite/tests/gadt/T19847a.hs - + testsuite/tests/gadt/T19847a.stderr - + testsuite/tests/gadt/T19847b.hs - testsuite/tests/gadt/all.T - + testsuite/tests/simplCore/should_compile/T22849.hs - testsuite/tests/simplCore/should_compile/all.T - + testsuite/tests/typecheck/should_compile/T19577.hs - + testsuite/tests/typecheck/should_compile/T21501.hs - + testsuite/tests/typecheck/should_compile/T22383.hs - testsuite/tests/typecheck/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: 2d59d551647d102c4af44f257c520a94f04ea3f6 + DOCKER_REV: 572353e0644044fe3a5465bba4342a9a0b0eb60e # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -441,6 +441,7 @@ data DataCon -- INVARIANT(dataConTyVars): the set of tyvars in dcUserTyVarBinders is -- exactly the set of tyvars (*not* covars) of dcExTyCoVars unioned -- with the set of dcUnivTyVars whose tyvars do not appear in dcEqSpec + -- So dcUserTyVarBinders is a subset of (dcUnivTyVars ++ dcExTyCoVars) -- See Note [DataCon user type variable binders] dcUserTyVarBinders :: [InvisTVBinder], ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -707,7 +707,7 @@ Worker/wrapper will unbox * is an algebraic data type (not a newtype) * is not recursive (as per 'isRecDataCon') * has a single constructor (thus is a "product") - * that may bind existentials + * that may bind existentials (#18982) We can transform > data D a = forall b. D a b > f (D @ex a b) = e @@ -1272,16 +1272,25 @@ also unbox its components. That is governed by the `usefulSplit` mechanism. -} -- | Exactly 'dataConInstArgTys', but lacks the (ASSERT'ed) precondition that --- the 'DataCon' may not have existentials. The lack of cloning the existentials --- compared to 'dataConInstExAndArgVars' makes this function \"dubious\"; --- only use it where type variables aren't substituted for! +-- the 'DataCon' may not have existentials. The lack of cloning the +-- existentials this function \"dubious\"; only use it where type variables +-- aren't substituted for! Why may the data con bind existentials? +-- See Note [Which types are unboxed?] dubiousDataConInstArgTys :: DataCon -> [Type] -> [Type] dubiousDataConInstArgTys dc tc_args = arg_tys where - univ_tvs = dataConUnivTyVars dc - ex_tvs = dataConExTyCoVars dc - subst = extendSubstInScopeList (zipTvSubst univ_tvs tc_args) ex_tvs - arg_tys = map (GHC.Core.Type.substTy subst . scaledThing) (dataConRepArgTys dc) + univ_tvs = dataConUnivTyVars dc + ex_tvs = dataConExTyCoVars dc + univ_subst = zipTvSubst univ_tvs tc_args + (full_subst, _) = substTyVarBndrs univ_subst ex_tvs + arg_tys = map (substTy full_subst . scaledThing) $ + dataConRepArgTys dc + -- NB: use substTyVarBndrs on ex_tvs to ensure that we + -- substitute in their kinds. For example (#22849) + -- Consider data T a where + -- MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a + -- Then dubiousDataConInstArgTys MkT [Type, Foo] should return + -- [Foo (ix::Type)], not [Foo (ix::k)]! findTypeShape :: FamInstEnvs -> Type -> TypeShape -- Uncover the arrow and product shape of a type ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -72,9 +72,12 @@ import Control.Arrow ( second ) import Control.Monad import GHC.Data.FastString import qualified Data.List.NonEmpty as NE + import GHC.Data.List.SetOps ( getNth ) import Language.Haskell.Syntax.Basic (FieldLabelString(..)) +import Data.List( partition ) + {- ************************************************************************ * * @@ -315,6 +318,11 @@ type Checker inp out = forall r. , r -- Result of thing inside ) +tcMultiple_ :: Checker inp () -> PatEnv -> [inp] -> TcM r -> TcM r +tcMultiple_ tc_pat penv args thing_inside + = do { (_, res) <- tcMultiple tc_pat penv args thing_inside + ; return res } + tcMultiple :: Checker inp out -> Checker [inp] [out] tcMultiple tc_pat penv args thing_inside = do { err_ctxt <- getErrCtxt @@ -861,10 +869,10 @@ tcConPat :: PatEnv -> LocatedN Name tcConPat penv con_lname@(L _ con_name) pat_ty arg_pats thing_inside = do { con_like <- tcLookupConLike con_name ; case con_like of - RealDataCon data_con -> tcDataConPat penv con_lname data_con - pat_ty arg_pats thing_inside - PatSynCon pat_syn -> tcPatSynPat penv con_lname pat_syn - pat_ty arg_pats thing_inside + RealDataCon data_con -> tcDataConPat con_lname data_con pat_ty + penv arg_pats thing_inside + PatSynCon pat_syn -> tcPatSynPat con_lname pat_syn pat_ty + penv arg_pats thing_inside } -- Warn when pattern matching on a GADT or a pattern synonym @@ -880,12 +888,11 @@ warnMonoLocalBinds -- In #20485 this was made into a warning. } -tcDataConPat :: PatEnv -> LocatedN Name -> DataCon +tcDataConPat :: LocatedN Name -> DataCon -> Scaled ExpSigmaTypeFRR -- Type of the pattern - -> HsConPatDetails GhcRn -> TcM a - -> TcM (Pat GhcTc, a) -tcDataConPat penv (L con_span con_name) data_con pat_ty_scaled - arg_pats thing_inside + -> Checker (HsConPatDetails GhcRn) (Pat GhcTc) +tcDataConPat (L con_span con_name) data_con pat_ty_scaled + penv arg_pats thing_inside = do { let tycon = dataConTyCon data_con -- For data families this is the representation tycon (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _) @@ -921,21 +928,15 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty_scaled -- Why "super"? See Note [Binding when looking up instances] -- in GHC.Core.InstEnv. - ; let arg_tys' = substScaledTys tenv arg_tys - pat_mult = scaledMult pat_ty_scaled + ; let arg_tys' = substScaledTys tenv arg_tys + pat_mult = scaledMult pat_ty_scaled arg_tys_scaled = map (scaleScaled pat_mult) arg_tys' + con_like = RealDataCon data_con -- This check is necessary to uphold the invariant that 'tcConArgs' -- is given argument types with a fixed runtime representation. -- See test case T20363. - ; zipWithM_ - ( \ i arg_sty -> - hasFixedRuntimeRep_syntactic - (FRRDataConPatArg data_con i) - (scaledThing arg_sty) - ) - [1..] - arg_tys' + ; checkFixedRuntimeRep data_con arg_tys' ; traceTc "tcConPat" (vcat [ text "con_name:" <+> ppr con_name , text "univ_tvs:" <+> pprTyVars univ_tvs @@ -947,11 +948,15 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty_scaled , text "pat_ty:" <+> ppr pat_ty , text "arg_tys':" <+> ppr arg_tys' , text "arg_pats" <+> ppr arg_pats ]) + + ; (univ_ty_args, ex_ty_args) <- splitConTyArgs con_like arg_pats + ; if null ex_tvs && null eq_spec && null theta then do { -- The common case; no class bindings etc -- (see Note [Arrows and patterns]) - (arg_pats', res) <- tcConArgs (RealDataCon data_con) arg_tys_scaled - tenv penv arg_pats thing_inside + (arg_pats', res) <- tcConTyArgs tenv penv univ_ty_args $ + tcConValArgs con_like arg_tys_scaled + penv arg_pats thing_inside ; let res_pat = ConPat { pat_con = header , pat_args = arg_pats' , pat_con_ext = ConPatTc @@ -974,8 +979,11 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty_scaled ; given <- newEvVars theta' ; (ev_binds, (arg_pats', res)) - <- checkConstraints (getSkolemInfo skol_info) ex_tvs' given $ - tcConArgs (RealDataCon data_con) arg_tys_scaled tenv penv arg_pats thing_inside + <- -- See Note [Type applications in patterns] (W4) + tcConTyArgs tenv penv univ_ty_args $ + checkConstraints (getSkolemInfo skol_info) ex_tvs' given $ + tcConTyArgs tenv penv ex_ty_args $ + tcConValArgs con_like arg_tys_scaled penv arg_pats thing_inside ; let res_pat = ConPat { pat_con = header @@ -991,11 +999,10 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty_scaled ; return (mkHsWrapPat wrap res_pat pat_ty, res) } } -tcPatSynPat :: PatEnv -> LocatedN Name -> PatSyn +tcPatSynPat :: LocatedN Name -> PatSyn -> Scaled ExpSigmaType -- ^ Type of the pattern - -> HsConPatDetails GhcRn -> TcM a - -> TcM (Pat GhcTc, a) -tcPatSynPat penv (L con_span con_name) pat_syn pat_ty arg_pats thing_inside + -> Checker (HsConPatDetails GhcRn) (Pat GhcTc) +tcPatSynPat (L con_span con_name) pat_syn pat_ty penv arg_pats thing_inside = do { let (univ_tvs, req_theta, ex_tvs, prov_theta, arg_tys, ty) = patSynSig pat_syn ; (subst, univ_tvs') <- newMetaTyVars univ_tvs @@ -1018,23 +1025,27 @@ tcPatSynPat penv (L con_span con_name) pat_syn pat_ty arg_pats thing_inside arg_tys_scaled = map (scaleScaled pat_mult) arg_tys' prov_theta' = substTheta tenv prov_theta req_theta' = substTheta tenv req_theta + con_like = PatSynCon pat_syn ; when (any isEqPred prov_theta) warnMonoLocalBinds ; mult_wrap <- checkManyPattern pat_ty -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify. - ; wrap <- tc_sub_type penv (scaledThing pat_ty) ty' - ; traceTc "tcPatSynPat" (ppr pat_syn $$ - ppr pat_ty $$ - ppr ty' $$ - ppr ex_tvs' $$ - ppr prov_theta' $$ - ppr req_theta' $$ - ppr arg_tys') + ; (univ_ty_args, ex_ty_args) <- splitConTyArgs con_like arg_pats - ; prov_dicts' <- newEvVars prov_theta' + ; wrap <- tc_sub_type penv (scaledThing pat_ty) ty' + ; traceTc "tcPatSynPat" $ + vcat [ text "Pat syn:" <+> ppr pat_syn + , text "Expected type:" <+> ppr pat_ty + , text "Pat res ty:" <+> ppr ty' + , text "ex_tvs':" <+> pprTyVars ex_tvs' + , text "prov_theta':" <+> ppr prov_theta' + , text "req_theta':" <+> ppr req_theta' + , text "arg_tys':" <+> ppr arg_tys' + , text "univ_ty_args:" <+> ppr univ_ty_args + , text "ex_ty_args:" <+> ppr ex_ty_args ] ; req_wrap <- instCall (OccurrenceOf con_name) (mkTyVarTys univ_tvs') req_theta' -- Origin (OccurrenceOf con_name): @@ -1055,11 +1066,16 @@ tcPatSynPat penv (L con_span con_name) pat_syn pat_ty arg_pats thing_inside , text "bad_arg_tys:" <+> ppr bad_arg_tys ] ; traceTc "checkConstraints {" Outputable.empty + ; prov_dicts' <- newEvVars prov_theta' ; (ev_binds, (arg_pats', res)) - <- checkConstraints (getSkolemInfo skol_info) ex_tvs' prov_dicts' $ - tcConArgs (PatSynCon pat_syn) arg_tys_scaled tenv penv arg_pats thing_inside - + <- -- See Note [Type applications in patterns] (W4) + tcConTyArgs tenv penv univ_ty_args $ + checkConstraints (getSkolemInfo skol_info) ex_tvs' prov_dicts' $ + tcConTyArgs tenv penv ex_ty_args $ + tcConValArgs con_like arg_tys_scaled penv arg_pats $ + thing_inside ; traceTc "checkConstraints }" (ppr ev_binds) + ; let res_pat = ConPat { pat_con = L con_span $ PatSynCon pat_syn , pat_args = arg_pats' , pat_con_ext = ConPatTc @@ -1073,6 +1089,14 @@ tcPatSynPat penv (L con_span con_name) pat_syn pat_ty arg_pats thing_inside ; pat_ty <- readExpType (scaledThing pat_ty) ; return (mkHsWrapPat (wrap <.> mult_wrap) res_pat pat_ty, res) } +checkFixedRuntimeRep :: DataCon -> [Scaled TcSigmaTypeFRR] -> TcM () +checkFixedRuntimeRep data_con arg_tys + = zipWithM_ check_one [1..] arg_tys + where + check_one i arg_ty = hasFixedRuntimeRep_syntactic + (FRRDataConPatArg data_con i) + (scaledThing arg_ty) + {- Note [Call-stack tracing of pattern synonyms] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider @@ -1187,84 +1211,128 @@ Suppose (coi, tys) = matchExpectedConType data_tc pat_ty error messages; it's a purely internal thing -} -{- -Note [Typechecking type applications in patterns] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -How should we typecheck type applications in patterns, such as +{- Note [Type applications in patterns] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Type applications in patterns are enabled by -XTypeAbstractions. +For example: f :: Either (Maybe a) [b] -> blah f (Left @x @[y] (v::Maybe x)) = blah -It's quite straightforward, and very similar to the treatment of -pattern signatures. +How should we typecheck them? The basic plan is pretty simple, and is +all done in tcConTyArgs. For each type argument: -* Step 1: bind the newly-in-scope type variables x and y to fresh - unification variables, say x0 and y0. +* Step 1: + * bind the newly-in-scope type variables (here `x` or `y`) to + unification variables, say `x0` or `y0` -* Step 2: typecheck those type arguments, @x and @[y], to get the - types x0 and [y0]. + * typecheck the type argument, `@x` or `@[y]` to get the + types `x0` or `[y0]`. -* Step 3: Unify those types with the type arguments we expect, - in this case (Maybe a) and [b]. These unifications will - (perhaps after the constraint solver has done its work) + This step is done by `tcHsPatSigType`, similar to the way we + deal with pattern signatures. + +* Step 2: Unify those types with the type arguments we expect from + the context, in this case (Maybe a) and [b]. These unifications + will (perhaps after the constraint solver has done its work) unify x0 := Maybe a y0 := b Thus we learn that x stands for (Maybe a) and y for b. -Wrinkles: - -* Surprisingly, we can discard the coercions arising from - these unifications. The *only* thing the unification does is - to side-effect those unification variables, so that we know - what type x and y stand for; and cause an error if the equality - is not soluble. It's a bit like a constraint arising - from a functional dependency, where we don't use the evidence. - -* Exactly the same works for existential arguments - data T where - MkT :: a -> a -> T - f :: T -> blah - f (MkT @x v w) = ... - Here we create a fresh unification variable x0 for x, and - unify it with the fresh existential variable bound by the pattern. - -* Note that both here and in pattern signatures the unification may - not even end up unifying the variable. For example - type S a b = a - f :: Maybe a -> Bool - f (Just @(S a b) x) = True :: b - In Step 3 we will unify (S a0 b0 ~ a), which succeeds, but has no - effect on the unification variable b0, to which 'b' is bound. - Later, in the RHS, we find that b0 must be Bool, and unify it there. - All is fine. +* Step 3: Extend the lexical context to bind `x` to `x0` and + `y` to `y0`, and typecheck the body of the pattern match. + +However there are several quite tricky wrinkles. + +(W1) Surprisingly, we can discard the coercions arising from + these unifications. The *only* thing the unification does is + to side-effect those unification variables, so that we know + what type x and y stand for; and cause an error if the equality + is not soluble. It's a bit like a constraint arising + from a functional dependency, where we don't use the evidence. + +(W2) Note that both here and in pattern signatures the unification may + not even end up unifying the variable. For example + type S a b = a + f :: Maybe a -> Bool + f (Just @(S a b) x) = True :: b + In Step 2 we will unify (S a0 b0 ~ a), which succeeds, but has no + effect on the unification variable b0, to which 'b' is bound. + Later, in the RHS, we find that b0 must be Bool, and unify it there. + All is fine. + +(W3) The order of the arguments to the /data constructor/ may differ from + the order of the arguments to the /type constructor/. Example + data T a b where { MkT :: forall c d. (c,d) -> T d c } + f :: T Int Bool -> blah + f (MkT @x @y p) = ... + The /first/ type argument to `MkT`, namely `@x` corresponds to the + /second/ argument to `T` in the type `T Int Bool`. So `x` is bound + to `Bool` -- not to `Int`!. That is why splitConTyArgs uses + conLikeUserTyVarBinders to match up with the user-supplied type arguments + in the pattern, not dataConUnivTyVars/dataConExTyVars. + +(W4) A similar story works for existentials, but it is subtly different + (#19847). Consider + data T a where { MkT :: forall a b. a -> b -> T a } + f :: T Int -> blah + f (MkT @x @y v w) = blah + Here we create a fresh unification variables x0,y0 for x,y and + unify x0~Int, y0~b, where b is the fresh existential variable bound by + the pattern. But + * (x0~Int) must be /outside/ the implication constraint + * (y0~b) must be /inside/ it + (and hence x0 and y0 themselves must have different levels). + Thus: + x0[1]~Int, (forall[2] b. (y0[2]~b, ...constraints-from-blah...)) + + We need (x0~Int) /outside/ so that it can influence the type of the + pattern in an inferred setting, e.g. + g :: T _ -> blah + g (MkT @Int @y v w) = blah + Here we want to infer `g` to have type `T Int -> blah`. If the + (x0~Int) was inside the implication, and the the constructor bound + equality constraints, `x0` would be untouchable. This was the root + cause of #19847. + + We need (y0~b) to be /inside/ the implication, so that `b` is in + scope. In fact, we may actually /need/ equalities bound by the + implication to prove the equality constraint we generate. + Example data T a where + MkT :: forall p q. T (p,q) + f :: T (Int,Bool) -> blah + f (MkT @Int @Bool) = ... + We get the implication + forall[2] p q. (p,q)~(Int,Bool) => (p ~ Int, q ~ Bool, ...) + where the Given comes from the GADT match, while (p~Int, q~Bool) + comes from matching the type arguments. + + Wow. That's all quite subtle! See the long discussion on #19847. We + must treat universal and existential arguments separately, even though + they are all mixed up (W3). The function splitConTyArgs separates the + universals from existentials; and we build the implication between + typechecking the two sets: + tcConTyArgs ... univ_ty_args $ + checkConstraints ... $ + tcConTyArgs ... ex_ty_args $ + ..typecheck body.. + You can see this code shape in tcDataConPat and tcPatSynPat. + + Where pattern synonyms are involved, this two-level split may not be + enough. See #22328 for the story. -} -tcConArgs :: ConLike - -> [Scaled TcSigmaTypeFRR] - -> Subst -- Instantiating substitution for constructor type - -> Checker (HsConPatDetails GhcRn) (HsConPatDetails GhcTc) -tcConArgs con_like arg_tys tenv penv con_args thing_inside = case con_args of +tcConValArgs :: ConLike + -> [Scaled TcSigmaTypeFRR] + -> Checker (HsConPatDetails GhcRn) (HsConPatDetails GhcTc) +tcConValArgs con_like arg_tys penv con_args thing_inside = case con_args of PrefixCon type_args arg_pats -> do + -- NB: type_args already dealt with + -- See Note [Type applications in patterns] { checkTc (con_arity == no_of_args) -- Check correct arity (arityErr (text "constructor") con_like con_arity no_of_args) - -- forgetting to filter out inferred binders led to #20443 - ; let con_spec_binders = filter ((== SpecifiedSpec) . binderFlag) $ - conLikeUserTyVarBinders con_like - ; checkTc (type_args `leLength` con_spec_binders) - (TcRnTooManyTyArgsInConPattern con_like (length con_spec_binders) (length type_args)) - ; let pats_w_tys = zipEqual "tcConArgs" arg_pats arg_tys - ; (type_args', (arg_pats', res)) - <- tcMultiple tcConTyArg penv type_args $ - tcMultiple tcConArg penv pats_w_tys thing_inside - - -- This unification is straight from Figure 7 of - -- "Type Variables in Patterns", Haskell'18 - ; _ <- zipWithM (unifyType Nothing) type_args' (substTyVars tenv $ - binderVars con_spec_binders) - -- OK to drop coercions here. These unifications are all about - -- guiding inference based on a user-written type annotation - -- See Note [Typechecking type applications in patterns] + ; (arg_pats', res) <- tcMultiple tcConArg penv pats_w_tys thing_inside ; return (PrefixCon type_args arg_pats', res) } where @@ -1321,23 +1389,72 @@ tcConArgs con_like arg_tys tenv penv con_args thing_inside = case con_args of -- dataConFieldLabels will be empty (and each field in the pattern -- will generate an error below). -tcConTyArg :: Checker (HsConPatTyArg GhcRn) TcType -tcConTyArg penv (HsConPatTyArg _ rn_ty) thing_inside + +splitConTyArgs :: ConLike -> HsConPatDetails GhcRn + -> TcM ( [(HsConPatTyArg GhcRn, TyVar)] -- Universals + , [(HsConPatTyArg GhcRn, TyVar)] ) -- Existentials +-- See Note [Type applications in patterns] (W4) +-- This function is monadic only because of the error check +-- for too many type arguments +splitConTyArgs con_like (PrefixCon type_args _) + = do { checkTc (type_args `leLength` con_spec_bndrs) + (TcRnTooManyTyArgsInConPattern con_like + (length con_spec_bndrs) (length type_args)) + ; if null ex_tvs -- Short cut common case + then return (bndr_ty_arg_prs, []) + else return (partition is_universal bndr_ty_arg_prs) } + where + ex_tvs = conLikeExTyCoVars con_like + con_spec_bndrs = [ tv | Bndr tv SpecifiedSpec <- conLikeUserTyVarBinders con_like ] + -- conLikeUserTyVarBinders: see (W3) in + -- Note [Type applications in patterns] + -- SpecifiedSpec: forgetting to filter out inferred binders led to #20443 + + bndr_ty_arg_prs = type_args `zip` con_spec_bndrs + -- The zip truncates to length(type_args) + + is_universal (_, tv) = not (tv `elem` ex_tvs) + -- See Note [DataCon user type variable binders] in GHC.Core.DataCon + -- especially INVARIANT(dataConTyVars). + +splitConTyArgs _ (RecCon {}) = return ([], []) -- No type args in RecCon +splitConTyArgs _ (InfixCon {}) = return ([], []) -- No type args in InfixCon + +tcConTyArgs :: Subst -> PatEnv -> [(HsConPatTyArg GhcRn, TyVar)] + -> TcM a -> TcM a +tcConTyArgs tenv penv prs thing_inside + = tcMultiple_ (tcConTyArg tenv) penv prs thing_inside + +tcConTyArg :: Subst -> Checker (HsConPatTyArg GhcRn, TyVar) () +tcConTyArg tenv penv (HsConPatTyArg _ rn_ty, con_tv) thing_inside = do { (sig_wcs, sig_ibs, arg_ty) <- tcHsPatSigType TypeAppCtxt HM_TyAppPat rn_ty AnyKind -- AnyKind is a bit suspect: it really should be the kind gotten -- from instantiating the constructor type. But this would be -- hard to get right, because earlier type patterns might influence -- the kinds of later patterns. In any case, it all gets checked - -- by the calls to unifyType in tcConArgs, which will also unify - -- kinds. + -- by the calls to unifyType below which unifies kinds + ; case NE.nonEmpty sig_ibs of Just sig_ibs_ne | inPatBind penv -> addErr (TcRnCannotBindTyVarsInPatBind sig_ibs_ne) _ -> pure () + + -- This unification is straight from Figure 7 of + -- "Type Variables in Patterns", Haskell'18 + -- OK to drop coercions here. These unifications are all about + -- guiding inference based on a user-written type annotation + -- See Note [Type applications in patterns] (W1) + ; _ <- unifyType Nothing arg_ty (substTyVar tenv con_tv) + ; result <- tcExtendNameTyVarEnv sig_wcs $ tcExtendNameTyVarEnv sig_ibs $ thing_inside - ; return (arg_ty, result) } + -- NB: Because we call tConTyArgs twice, once for universals and + -- once for existentials; so this brings things into scope + -- "out of left-right order". But it doesn't matter; the renamer + -- has dealt with all that. + + ; return ((), result) } tcConArg :: Checker (LPat GhcRn, Scaled TcSigmaType) (LPat GhcTc) tcConArg penv (arg_pat, Scaled arg_mult arg_ty) ===================================== compiler/GHC/Wasm/ControlFlow/FromCmm.hs ===================================== @@ -75,7 +75,7 @@ flowLeaving platform b = let (offset, target_labels) = switchTargetsToTable targets (lo, hi) = switchTargetsRange targets default_label = switchTargetsDefault targets - scrutinee = smartPlus platform e offset + scrutinee = smartExtend platform $ smartPlus platform e offset range = inclusiveInterval (lo+toInteger offset) (hi+toInteger offset) in Switch scrutinee range target_labels default_label CmmCall { cml_cont = Nothing, cml_target = e } -> TailCall e @@ -314,6 +314,14 @@ structuredControl platform txExpr txBlock g = nodeBody :: CmmBlock -> CmmActions nodeBody (BlockCC _first middle _last) = middle +-- | A CmmSwitch scrutinee may have any width, but a br_table operand +-- must be exactly word sized, hence the extension here. (#22871) +smartExtend :: Platform -> CmmExpr -> CmmExpr +smartExtend p e | w0 == w1 = e + | otherwise = CmmMachOp (MO_UU_Conv w0 w1) [e] + where + w0 = cmmExprWidth p e + w1 = wordWidth p smartPlus :: Platform -> CmmExpr -> Int -> CmmExpr smartPlus _ e 0 = e ===================================== configure.ac ===================================== @@ -554,8 +554,8 @@ AC_SUBST(InstallNameToolCmd) # tools we are looking for. In the past, GHC supported a number of # versions of LLVM simultaneously, but that stopped working around # 3.5/3.6 release of LLVM. -LlvmMinVersion=10 # inclusive -LlvmMaxVersion=15 # not inclusive +LlvmMinVersion=11 # inclusive +LlvmMaxVersion=16 # not inclusive AC_SUBST([LlvmMinVersion]) AC_SUBST([LlvmMaxVersion]) sUPPORTED_LLVM_VERSION_MIN=$(echo \($LlvmMinVersion\) | sed 's/\./,/') ===================================== libraries/transformers ===================================== @@ -1 +1 @@ -Subproject commit 2745db6c374c7e830a0f8fdeb8cc39bd8f054f36 +Subproject commit ceff1dcd7893f7ab4abb6e66bcd248abd86c8886 ===================================== llvm-passes ===================================== @@ -1,5 +1,5 @@ [ -(0, "-mem2reg -globalopt -lower-expect"), -(1, "-O1 -globalopt"), -(2, "-O2") +(0, "-enable-new-pm=0 -mem2reg -globalopt -lower-expect"), +(1, "-enable-new-pm=0 -O1 -globalopt"), +(2, "-enable-new-pm=0 -O2") ] ===================================== testsuite/tests/cmm/should_run/T22871.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnliftedFFITypes #-} + +import Data.Foldable +import GHC.Exts +import GHC.Int + +foreign import prim "foo" foo :: Int64# -> Int64# + +main :: IO () +main = for_ [0, 42, 114514] $ \(I64# x#) -> print $ I64# (foo x#) ===================================== testsuite/tests/cmm/should_run/T22871.stdout ===================================== @@ -0,0 +1,3 @@ +233 +84 +1919810 ===================================== testsuite/tests/cmm/should_run/T22871_cmm.cmm ===================================== @@ -0,0 +1,16 @@ +#include "Cmm.h" + +foo (I64 x) { + switch [0 .. 114514] (x) { + case 0: { return (233 :: I64); } + case 1: { return (333 :: I64); } + case 2: { return (666 :: I64); } + case 3: { return (1989 :: I64); } + case 4: { return (1997 :: I64); } + case 5: { return (2012 :: I64); } + case 6: { return (2019 :: I64); } + case 7: { return (2022 :: I64); } + case 114514: { return (1919810 :: I64); } + default: { return (x * (2 :: I64)); } + } +} ===================================== testsuite/tests/cmm/should_run/all.T ===================================== @@ -25,3 +25,12 @@ test('ByteSwitch', ], multi_compile_and_run, ['ByteSwitch', [('ByteSwitch_cmm.cmm', '')], '']) + +test('T22871', + [ extra_run_opts('"' + config.libdir + '"') + , omit_ways(['ghci']) + , js_skip + , when(arch('i386'), skip) # x86 NCG panics with "iselExpr64(i386)" + ], + multi_compile_and_run, + ['T22871', [('T22871_cmm.cmm', '')], '']) ===================================== testsuite/tests/gadt/T19847.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE GADTs, PatternSynonyms, ViewPatterns, ScopedTypeVariables #-} + +module T19847 where + +import Data.Kind +import Type.Reflection + +pattern Is :: forall (b :: Type) (a :: Type). Typeable b => (a ~ b) => TypeRep a +pattern Is <- (eqTypeRep (typeRep @b) -> Just HRefl) + where Is = typeRep + +def :: TypeRep a -> a +def x = case x of + Is @Int -> 10 + Is @Bool -> False ===================================== testsuite/tests/gadt/T19847a.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE LambdaCase, GADTs, ScopedTypeVariables, TypeAbstractions #-} + +module T19847a where + +data T a b c where + MkT :: forall c y x b. (x~y, c~[x], Ord x) => x -> y -> T (x,y) b c + +f :: forall b c. (T (Int,Int) b c -> Bool) -> (b,c) +f = error "urk" + +h = f (\case { MkT @_ @_ @_ @Int p q -> True }) +-- Check that the @Int argument can affect +-- the type at which `f` is instantiated +-- So h :: forall c. (Int,c) ===================================== testsuite/tests/gadt/T19847a.stderr ===================================== @@ -0,0 +1,12 @@ +TYPE SIGNATURES + f :: forall b c. (T (Int, Int) b c -> Bool) -> (b, c) + h :: forall {c}. (Int, c) +TYPE CONSTRUCTORS + data type T{4} :: forall {k}. * -> k -> * -> * + roles nominal nominal phantom nominal +DATA CONSTRUCTORS + MkT :: forall {k} c y x (b :: k). + (x ~ y, c ~ [x], Ord x) => + x -> y -> T (x, y) b c +Dependent modules: [] +Dependent packages: [base-4.18.0.0] ===================================== testsuite/tests/gadt/T19847b.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeAbstractions, GADTs #-} + +module T19847b where + +import Data.Kind + +data T (a :: Type) b where + MkT4 :: forall a b. b ~ a => T a b + +foo x = (case x of MkT4 @Bool -> ()) :: () ===================================== testsuite/tests/gadt/all.T ===================================== @@ -126,3 +126,6 @@ test('SynDataRec', normal, compile, ['']) test('T20485', normal, compile, ['']) test('T20485a', normal, compile, ['']) test('T22235', normal, compile, ['']) +test('T19847', normal, compile, ['']) +test('T19847a', normal, compile, ['-ddump-types']) +test('T19847b', normal, compile, ['']) ===================================== testsuite/tests/simplCore/should_compile/T22849.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE GADTs #-} + +module T22849 where + +data Foo a where + Foo :: Foo Int + +data Bar a = Bar a (Foo a) + +data Some t = forall ix. Some (t ix) + +instance Show (Some Bar) where + show (Some (Bar v t)) = case t of + Foo -> show v ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -453,7 +453,7 @@ test('T22375', normal, compile, ['-O -ddump-simpl -dsuppress-uniques -dno-typeab test('T21851_2', [grep_errmsg(r'wwombat') ], multimod_compile, ['T21851_2', '-O -dno-typeable-binds -dsuppress-uniques']) # Should not inline m, so there shouldn't be a single YES test('T22317', [grep_errmsg(r'ANSWER = YES') ], compile, ['-O -dinline-check m -ddebug-output']) - +test('T22849', normal, compile, ['-O']) test('T22634', normal, compile, ['-O -fcatch-nonexhaustive-cases']) test('T22494', [grep_errmsg(r'case') ], compile, ['-O -ddump-simpl -dsuppress-uniques']) test('T22491', normal, compile, ['-O2']) @@ -472,3 +472,4 @@ test('T22611', [when(wordsize(32), skip), grep_errmsg(r'\$salterF') ], compile, test('T22715_2', normal, multimod_compile, ['T22715_2', '-v0 -O -fspecialise-aggressively']) test('T22802', normal, compile, ['-O']) test('T15205', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) + ===================================== testsuite/tests/typecheck/should_compile/T19577.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RankNTypes #-} + +module T19577 where + +data SBool (b :: Bool) where + STrue :: forall b. (b ~ 'True) => SBool b + SFalse :: forall b. (b ~ 'False) => SBool b + +class Blah b where + blah :: SBool b + +instance Blah 'True where + blah = STrue + +foo :: Blah b => (SBool b -> Int) -> Int +foo f = f blah + +bar = foo (\(STrue @True) -> 42) ===================================== testsuite/tests/typecheck/should_compile/T21501.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE MonoLocalBinds, PatternSynonyms, ViewPatterns, TypeAbstractions #-} + +module T21501 where + +import Data.Kind +import Type.Reflection + +pattern TypeApp :: + forall {k1} {k2} (f :: k1 -> k2) (result :: k2). + Typeable f => + forall (arg :: k1). + result ~ f arg => + TypeRep arg -> + TypeRep result +pattern TypeApp arg_rep <- App (eqTypeRep (typeRep @f) -> Just HRefl) arg_rep + +f :: TypeRep (a :: Type) -> String +f (TypeApp @[] rep) = show rep + +{- Expected type: TypeRep k (a::k) + Instantiate at k10 k20 (f0 :: k10 -> k20) (result0 :: k20) + Unify (TypeRep k (a::k) ~ TypeRep k20 (result :: k20) + Unify f0 ~ [] +-} ===================================== testsuite/tests/typecheck/should_compile/T22383.hs ===================================== @@ -0,0 +1,83 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase, ScopedTypeVariables #-} + +module T22383 where + +import Data.Kind (Type) +import Data.Proxy (Proxy(Proxy)) + +-- | @IsType k@ witnesses that @k ~ Type at . +data IsType k where + IsType :: IsType Type + +--------------------- +-- Using a GADT +--------------------- + +data FromType where + FromType :: forall (f :: Type -> Type). FromType + +-- | @FunRep (f b)@ witnesses that @b :: Type at . +data FunRep a where + AppK :: + forall (k :: Type) (f :: k -> Type) (b :: k). + IsType k -> + Proxy f -> + FunRep (f b) + +-- Could not deduce: k ~ * +isMaybeF :: forall (a :: Type). FunRep a -> FromType +isMaybeF = \case + AppK @_ @f @_ t (Proxy @g :: Proxy h) -> + case t of + IsType -> FromType @f + +-- Could not deduce: k ~ * +isMaybeG :: forall (a :: Type). FunRep a -> FromType +isMaybeG = \case + AppK @_ @f @_ t (Proxy @g :: Proxy h) -> + case t of + IsType -> FromType @g + +-- Works fine +isMaybeH :: forall (a :: Type). FunRep a -> FromType +isMaybeH = \case + AppK @_ @f @_ t (Proxy @g :: Proxy h) -> + case t of + IsType -> FromType @h + + +--------------------- +-- Not using a GADT +--------------------- + +data FunRep2 a where + AppK2 :: + forall k (b :: k). + IsType k -> + Proxy k -> + FunRep2 b + +data FromType2 where + FromType2 :: forall (b :: Type). FromType2 + +-- Could not deduce: k ~ * +isMaybeF2 :: forall k (a :: k). FunRep2 a -> FromType2 +isMaybeF2 = \case + AppK2 @_ @f t (Proxy @g :: Proxy h) -> + case t of + IsType -> FromType2 @f + +-- Works fine +isMaybeG2 :: forall k (a :: k). FunRep2 a -> FromType2 +isMaybeG2 = \case + AppK2 @_ @f t (Proxy @g :: Proxy h) -> + case t of + IsType -> FromType2 @g + +-- Works fine +isMaybeH2 :: forall k (a :: k). FunRep2 a -> FromType2 +isMaybeH2 = \case + AppK2 @_ @f t (Proxy @g :: Proxy h) -> + case t of + IsType -> FromType2 @h ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -854,3 +854,6 @@ test('T22310', normal, compile, ['']) test('T22331', normal, compile, ['']) test('T22516', normal, compile, ['']) test('T22647', normal, compile, ['']) +test('T19577', normal, compile, ['']) +test('T22383', normal, compile, ['']) +test('T21501', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/133344e0dbff97baafbd45377e3d3595f6f9232d...407703c34ffb649bbcf87a3218304342fd48ac16 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/133344e0dbff97baafbd45377e3d3595f6f9232d...407703c34ffb649bbcf87a3218304342fd48ac16 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 1 13:31:43 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 01 Feb 2023 08:31:43 -0500 Subject: [Git][ghc/ghc][wip/mp-backports-9.6] 30 commits: EPA: Add SourceText to HsOverLabel Message-ID: <63da69bf6d38b_2a4f55fc813616da@gitlab.mail> Matthew Pickering pushed to branch wip/mp-backports-9.6 at Glasgow Haskell Compiler / GHC Commits: 686350e9 by Alan Zimmerman at 2023-02-01T13:18:46+00:00 EPA: Add SourceText to HsOverLabel To be able to capture string literals with possible escape codes as labels. Close #22771 (cherry picked from commit fec7c2ea8242773b53b253d9536426f743443944) - - - - - 9cdab037 by Ben Gamari at 2023-02-01T13:18:46+00:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 (cherry picked from commit e480fbc2c6fdcb252847fc537ab7ec50d1dc2dfd) - - - - - be39064e by Ben Gamari at 2023-02-01T13:18:46+00:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. (cherry picked from commit 56c1bd986ac13e3a1fe1149f011480e44f857f5a) - - - - - 80a6bb73 by nineonine at 2023-02-01T13:18:46+00:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. (cherry picked from commit b3a3534b6f75b34dc4db76e904e071485da6d5cc) - - - - - 3c21d69d by Ben Gamari at 2023-02-01T13:18:46+00:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. (cherry picked from commit be417a47c7695998dea0adc05489a7b8838a78b6) - - - - - ac6c24f7 by Ben Gamari at 2023-02-01T13:18:46+00:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. (cherry picked from commit 30989d137b8f3a8fddbfd116e04b48f23c24f86c) - - - - - 6c212ccc by Ben Gamari at 2023-02-01T13:18:46+00:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. (cherry picked from commit 7566fd9de38c67360c090f828923d41587af519c) - - - - - 79241b6d by Ben Gamari at 2023-02-01T13:18:46+00:00 testsuite: Add regression test for #22798 (cherry picked from commit 2cb500a5ee1a31dfe1a2cdd71f175442026eb082) - - - - - d9e8c39d by Simon Peyton Jones at 2023-02-01T13:18:46+00:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 (cherry picked from commit 638277ba7bd2683f539afb0bf469fe75376994e2) - - - - - 86dc9a79 by Zubin Duggal at 2023-02-01T13:18:46+00:00 bindist configure: Fail if find not found (#22691) (cherry picked from commit c9967d137cff83c7688e26f87a8b5e196a75ec93) - - - - - 86d88743 by Oleg Grenrus at 2023-02-01T13:18:47+00:00 Add Foldable1 Solo instance (cherry picked from commit 082b7d43ee4b8203dc9bca53e5e1f7a45c42eeb8) - - - - - 2eb49ea6 by Krzysztof Gogolewski at 2023-02-01T13:18:47+00:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 (cherry picked from commit f83374f8649e5d8413e7ed585b0e058690c38563) - - - - - 632937bb by Ryan Scott at 2023-02-01T13:18:47+00:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. (cherry picked from commit 20598ef6d9e26e2e0af9ac42a42e7be00d7cc4f3) - - - - - 2efb886c by Ryan Scott at 2023-02-01T13:18:47+00:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. (cherry picked from commit 2f1450521b816a7d287b72deba14d59b6ccfbdbf) - - - - - fc117e3d by Ben Gamari at 2023-02-01T13:18:47+00:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. (cherry picked from commit a2d814dc84dbdcdb6c1e274b8bd7c212cc98c39e) - - - - - 6e1498fa by Ben Gamari at 2023-02-01T13:18:47+00:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. (cherry picked from commit f838815c365773a8107bf035a8ec27b8ff6ecc8b) - - - - - 1f42664c by Ben Gamari at 2023-02-01T13:18:47+00:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. (cherry picked from commit 2e48c19a7faf975318e954faea26f37deb763ac0) - - - - - 653c7513 by Ben Gamari at 2023-02-01T13:18:47+00:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. (cherry picked from commit 93f0e3c49cea484bd6e838892ff8702ec51f34c3) - - - - - 3ac79844 by Simon Peyton Jones at 2023-02-01T13:18:47+00:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) (cherry picked from commit d0f34f25ceaae9ef0a21f15f811469d0bed9da69) - - - - - fb186399 by Bodigrim at 2023-02-01T13:18:47+00:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} (cherry picked from commit c9ad8852bdd083f8692361134bc247a1eb2bbd77) - - - - - fdfd8911 by Cheng Shao at 2023-02-01T13:18:47+00:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. (cherry picked from commit 7e11c6dc25cb9dd14ae33ee9715ddbc8ebf9836e) - - - - - adf17604 by Cheng Shao at 2023-02-01T13:18:47+00:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. (cherry picked from commit 6ea2aa0293aedea2f873b7b5d9cff5e7b9e2f188) - - - - - 329097fc by Matthew Pickering at 2023-02-01T13:18:47+00:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 (cherry picked from commit 7cbdaad0396cee561f125c95f3352cebabd8ed99) - - - - - 5695611e by Cheng Shao at 2023-02-01T13:18:47+00:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. (cherry picked from commit 78c07219d5dad9730bbe3ec26ad22912ff22f058) - - - - - c4cc32d9 by Cheng Shao at 2023-02-01T13:18:47+00:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. (cherry picked from commit da468391872f6be286db37a0f016a37f9f362509) - - - - - 8f29bdae by Cheng Shao at 2023-02-01T13:18:47+00:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. (cherry picked from commit fd8f32bf551c34b95275ebb4fe648680013156f3) - - - - - 343c856f by Cheng Shao at 2023-02-01T13:18:47+00:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. (cherry picked from commit 7716cbe64862932fd69348b2594a14f2092e1c02) - - - - - e377aa49 by Ben Gamari at 2023-02-01T13:18:47+00:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. (cherry picked from commit 22089f693cf6e662a58a7011adb94d7f768ad2d7) - - - - - d91e6233 by Cheng Shao at 2023-02-01T13:18:47+00:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. (cherry picked from commit f0eefa3cf058879246991747dcd18c811402f9e5) - - - - - 30d3c827 by Ben Gamari at 2023-02-01T13:18:47+00:00 nativeGen/X86: MFENCE is unnecessary for release semantics In #22764 a user noticed that a program implementing a simple atomic counter via an STRef regressed significantly due to the introduction of necessary atomic operations in the MutVar# primops (#22468). This regression was caused by a bug in the NCG, which emitted an unnecessary MFENCE instruction for a release-ordered atomic write. MFENCE is rather only needed to achieve sequentially consistent ordering. Fixes #22764. (cherry picked from commit f058e3672b969f301b6b1637f8ab081654ec947a) - - - - - 30 changed files: - .gitlab-ci.yml - cabal.project-reinstall - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToAsm/Wasm/Utils.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Foreign/C.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ee995a19bd689064aa401d44a738046b0ef7974f...30d3c8271b867ff9d6c2514632632b9483a09056 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ee995a19bd689064aa401d44a738046b0ef7974f...30d3c8271b867ff9d6c2514632632b9483a09056 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 1 15:09:06 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Wed, 01 Feb 2023 10:09:06 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T21776 Message-ID: <63da809234055_2a4f2e64f88813885d2@gitlab.mail> Finley McIlwaine pushed new branch wip/T21776 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T21776 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 1 17:31:22 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 01 Feb 2023 12:31:22 -0500 Subject: [Git][ghc/ghc][master] Improve treatment of type applications in patterns Message-ID: <63daa1ea358bf_2a4fa049e44143443d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 11 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Tc/Gen/Pat.hs - + testsuite/tests/gadt/T19847.hs - + testsuite/tests/gadt/T19847a.hs - + testsuite/tests/gadt/T19847a.stderr - + testsuite/tests/gadt/T19847b.hs - testsuite/tests/gadt/all.T - + testsuite/tests/typecheck/should_compile/T19577.hs - + testsuite/tests/typecheck/should_compile/T21501.hs - + testsuite/tests/typecheck/should_compile/T22383.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -441,6 +441,7 @@ data DataCon -- INVARIANT(dataConTyVars): the set of tyvars in dcUserTyVarBinders is -- exactly the set of tyvars (*not* covars) of dcExTyCoVars unioned -- with the set of dcUnivTyVars whose tyvars do not appear in dcEqSpec + -- So dcUserTyVarBinders is a subset of (dcUnivTyVars ++ dcExTyCoVars) -- See Note [DataCon user type variable binders] dcUserTyVarBinders :: [InvisTVBinder], ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -72,9 +72,12 @@ import Control.Arrow ( second ) import Control.Monad import GHC.Data.FastString import qualified Data.List.NonEmpty as NE + import GHC.Data.List.SetOps ( getNth ) import Language.Haskell.Syntax.Basic (FieldLabelString(..)) +import Data.List( partition ) + {- ************************************************************************ * * @@ -315,6 +318,11 @@ type Checker inp out = forall r. , r -- Result of thing inside ) +tcMultiple_ :: Checker inp () -> PatEnv -> [inp] -> TcM r -> TcM r +tcMultiple_ tc_pat penv args thing_inside + = do { (_, res) <- tcMultiple tc_pat penv args thing_inside + ; return res } + tcMultiple :: Checker inp out -> Checker [inp] [out] tcMultiple tc_pat penv args thing_inside = do { err_ctxt <- getErrCtxt @@ -861,10 +869,10 @@ tcConPat :: PatEnv -> LocatedN Name tcConPat penv con_lname@(L _ con_name) pat_ty arg_pats thing_inside = do { con_like <- tcLookupConLike con_name ; case con_like of - RealDataCon data_con -> tcDataConPat penv con_lname data_con - pat_ty arg_pats thing_inside - PatSynCon pat_syn -> tcPatSynPat penv con_lname pat_syn - pat_ty arg_pats thing_inside + RealDataCon data_con -> tcDataConPat con_lname data_con pat_ty + penv arg_pats thing_inside + PatSynCon pat_syn -> tcPatSynPat con_lname pat_syn pat_ty + penv arg_pats thing_inside } -- Warn when pattern matching on a GADT or a pattern synonym @@ -880,12 +888,11 @@ warnMonoLocalBinds -- In #20485 this was made into a warning. } -tcDataConPat :: PatEnv -> LocatedN Name -> DataCon +tcDataConPat :: LocatedN Name -> DataCon -> Scaled ExpSigmaTypeFRR -- Type of the pattern - -> HsConPatDetails GhcRn -> TcM a - -> TcM (Pat GhcTc, a) -tcDataConPat penv (L con_span con_name) data_con pat_ty_scaled - arg_pats thing_inside + -> Checker (HsConPatDetails GhcRn) (Pat GhcTc) +tcDataConPat (L con_span con_name) data_con pat_ty_scaled + penv arg_pats thing_inside = do { let tycon = dataConTyCon data_con -- For data families this is the representation tycon (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _) @@ -921,21 +928,15 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty_scaled -- Why "super"? See Note [Binding when looking up instances] -- in GHC.Core.InstEnv. - ; let arg_tys' = substScaledTys tenv arg_tys - pat_mult = scaledMult pat_ty_scaled + ; let arg_tys' = substScaledTys tenv arg_tys + pat_mult = scaledMult pat_ty_scaled arg_tys_scaled = map (scaleScaled pat_mult) arg_tys' + con_like = RealDataCon data_con -- This check is necessary to uphold the invariant that 'tcConArgs' -- is given argument types with a fixed runtime representation. -- See test case T20363. - ; zipWithM_ - ( \ i arg_sty -> - hasFixedRuntimeRep_syntactic - (FRRDataConPatArg data_con i) - (scaledThing arg_sty) - ) - [1..] - arg_tys' + ; checkFixedRuntimeRep data_con arg_tys' ; traceTc "tcConPat" (vcat [ text "con_name:" <+> ppr con_name , text "univ_tvs:" <+> pprTyVars univ_tvs @@ -947,11 +948,15 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty_scaled , text "pat_ty:" <+> ppr pat_ty , text "arg_tys':" <+> ppr arg_tys' , text "arg_pats" <+> ppr arg_pats ]) + + ; (univ_ty_args, ex_ty_args) <- splitConTyArgs con_like arg_pats + ; if null ex_tvs && null eq_spec && null theta then do { -- The common case; no class bindings etc -- (see Note [Arrows and patterns]) - (arg_pats', res) <- tcConArgs (RealDataCon data_con) arg_tys_scaled - tenv penv arg_pats thing_inside + (arg_pats', res) <- tcConTyArgs tenv penv univ_ty_args $ + tcConValArgs con_like arg_tys_scaled + penv arg_pats thing_inside ; let res_pat = ConPat { pat_con = header , pat_args = arg_pats' , pat_con_ext = ConPatTc @@ -974,8 +979,11 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty_scaled ; given <- newEvVars theta' ; (ev_binds, (arg_pats', res)) - <- checkConstraints (getSkolemInfo skol_info) ex_tvs' given $ - tcConArgs (RealDataCon data_con) arg_tys_scaled tenv penv arg_pats thing_inside + <- -- See Note [Type applications in patterns] (W4) + tcConTyArgs tenv penv univ_ty_args $ + checkConstraints (getSkolemInfo skol_info) ex_tvs' given $ + tcConTyArgs tenv penv ex_ty_args $ + tcConValArgs con_like arg_tys_scaled penv arg_pats thing_inside ; let res_pat = ConPat { pat_con = header @@ -991,11 +999,10 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty_scaled ; return (mkHsWrapPat wrap res_pat pat_ty, res) } } -tcPatSynPat :: PatEnv -> LocatedN Name -> PatSyn +tcPatSynPat :: LocatedN Name -> PatSyn -> Scaled ExpSigmaType -- ^ Type of the pattern - -> HsConPatDetails GhcRn -> TcM a - -> TcM (Pat GhcTc, a) -tcPatSynPat penv (L con_span con_name) pat_syn pat_ty arg_pats thing_inside + -> Checker (HsConPatDetails GhcRn) (Pat GhcTc) +tcPatSynPat (L con_span con_name) pat_syn pat_ty penv arg_pats thing_inside = do { let (univ_tvs, req_theta, ex_tvs, prov_theta, arg_tys, ty) = patSynSig pat_syn ; (subst, univ_tvs') <- newMetaTyVars univ_tvs @@ -1018,23 +1025,27 @@ tcPatSynPat penv (L con_span con_name) pat_syn pat_ty arg_pats thing_inside arg_tys_scaled = map (scaleScaled pat_mult) arg_tys' prov_theta' = substTheta tenv prov_theta req_theta' = substTheta tenv req_theta + con_like = PatSynCon pat_syn ; when (any isEqPred prov_theta) warnMonoLocalBinds ; mult_wrap <- checkManyPattern pat_ty -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify. - ; wrap <- tc_sub_type penv (scaledThing pat_ty) ty' - ; traceTc "tcPatSynPat" (ppr pat_syn $$ - ppr pat_ty $$ - ppr ty' $$ - ppr ex_tvs' $$ - ppr prov_theta' $$ - ppr req_theta' $$ - ppr arg_tys') + ; (univ_ty_args, ex_ty_args) <- splitConTyArgs con_like arg_pats - ; prov_dicts' <- newEvVars prov_theta' + ; wrap <- tc_sub_type penv (scaledThing pat_ty) ty' + ; traceTc "tcPatSynPat" $ + vcat [ text "Pat syn:" <+> ppr pat_syn + , text "Expected type:" <+> ppr pat_ty + , text "Pat res ty:" <+> ppr ty' + , text "ex_tvs':" <+> pprTyVars ex_tvs' + , text "prov_theta':" <+> ppr prov_theta' + , text "req_theta':" <+> ppr req_theta' + , text "arg_tys':" <+> ppr arg_tys' + , text "univ_ty_args:" <+> ppr univ_ty_args + , text "ex_ty_args:" <+> ppr ex_ty_args ] ; req_wrap <- instCall (OccurrenceOf con_name) (mkTyVarTys univ_tvs') req_theta' -- Origin (OccurrenceOf con_name): @@ -1055,11 +1066,16 @@ tcPatSynPat penv (L con_span con_name) pat_syn pat_ty arg_pats thing_inside , text "bad_arg_tys:" <+> ppr bad_arg_tys ] ; traceTc "checkConstraints {" Outputable.empty + ; prov_dicts' <- newEvVars prov_theta' ; (ev_binds, (arg_pats', res)) - <- checkConstraints (getSkolemInfo skol_info) ex_tvs' prov_dicts' $ - tcConArgs (PatSynCon pat_syn) arg_tys_scaled tenv penv arg_pats thing_inside - + <- -- See Note [Type applications in patterns] (W4) + tcConTyArgs tenv penv univ_ty_args $ + checkConstraints (getSkolemInfo skol_info) ex_tvs' prov_dicts' $ + tcConTyArgs tenv penv ex_ty_args $ + tcConValArgs con_like arg_tys_scaled penv arg_pats $ + thing_inside ; traceTc "checkConstraints }" (ppr ev_binds) + ; let res_pat = ConPat { pat_con = L con_span $ PatSynCon pat_syn , pat_args = arg_pats' , pat_con_ext = ConPatTc @@ -1073,6 +1089,14 @@ tcPatSynPat penv (L con_span con_name) pat_syn pat_ty arg_pats thing_inside ; pat_ty <- readExpType (scaledThing pat_ty) ; return (mkHsWrapPat (wrap <.> mult_wrap) res_pat pat_ty, res) } +checkFixedRuntimeRep :: DataCon -> [Scaled TcSigmaTypeFRR] -> TcM () +checkFixedRuntimeRep data_con arg_tys + = zipWithM_ check_one [1..] arg_tys + where + check_one i arg_ty = hasFixedRuntimeRep_syntactic + (FRRDataConPatArg data_con i) + (scaledThing arg_ty) + {- Note [Call-stack tracing of pattern synonyms] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider @@ -1187,84 +1211,128 @@ Suppose (coi, tys) = matchExpectedConType data_tc pat_ty error messages; it's a purely internal thing -} -{- -Note [Typechecking type applications in patterns] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -How should we typecheck type applications in patterns, such as +{- Note [Type applications in patterns] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Type applications in patterns are enabled by -XTypeAbstractions. +For example: f :: Either (Maybe a) [b] -> blah f (Left @x @[y] (v::Maybe x)) = blah -It's quite straightforward, and very similar to the treatment of -pattern signatures. +How should we typecheck them? The basic plan is pretty simple, and is +all done in tcConTyArgs. For each type argument: -* Step 1: bind the newly-in-scope type variables x and y to fresh - unification variables, say x0 and y0. +* Step 1: + * bind the newly-in-scope type variables (here `x` or `y`) to + unification variables, say `x0` or `y0` -* Step 2: typecheck those type arguments, @x and @[y], to get the - types x0 and [y0]. + * typecheck the type argument, `@x` or `@[y]` to get the + types `x0` or `[y0]`. -* Step 3: Unify those types with the type arguments we expect, - in this case (Maybe a) and [b]. These unifications will - (perhaps after the constraint solver has done its work) + This step is done by `tcHsPatSigType`, similar to the way we + deal with pattern signatures. + +* Step 2: Unify those types with the type arguments we expect from + the context, in this case (Maybe a) and [b]. These unifications + will (perhaps after the constraint solver has done its work) unify x0 := Maybe a y0 := b Thus we learn that x stands for (Maybe a) and y for b. -Wrinkles: - -* Surprisingly, we can discard the coercions arising from - these unifications. The *only* thing the unification does is - to side-effect those unification variables, so that we know - what type x and y stand for; and cause an error if the equality - is not soluble. It's a bit like a constraint arising - from a functional dependency, where we don't use the evidence. - -* Exactly the same works for existential arguments - data T where - MkT :: a -> a -> T - f :: T -> blah - f (MkT @x v w) = ... - Here we create a fresh unification variable x0 for x, and - unify it with the fresh existential variable bound by the pattern. - -* Note that both here and in pattern signatures the unification may - not even end up unifying the variable. For example - type S a b = a - f :: Maybe a -> Bool - f (Just @(S a b) x) = True :: b - In Step 3 we will unify (S a0 b0 ~ a), which succeeds, but has no - effect on the unification variable b0, to which 'b' is bound. - Later, in the RHS, we find that b0 must be Bool, and unify it there. - All is fine. +* Step 3: Extend the lexical context to bind `x` to `x0` and + `y` to `y0`, and typecheck the body of the pattern match. + +However there are several quite tricky wrinkles. + +(W1) Surprisingly, we can discard the coercions arising from + these unifications. The *only* thing the unification does is + to side-effect those unification variables, so that we know + what type x and y stand for; and cause an error if the equality + is not soluble. It's a bit like a constraint arising + from a functional dependency, where we don't use the evidence. + +(W2) Note that both here and in pattern signatures the unification may + not even end up unifying the variable. For example + type S a b = a + f :: Maybe a -> Bool + f (Just @(S a b) x) = True :: b + In Step 2 we will unify (S a0 b0 ~ a), which succeeds, but has no + effect on the unification variable b0, to which 'b' is bound. + Later, in the RHS, we find that b0 must be Bool, and unify it there. + All is fine. + +(W3) The order of the arguments to the /data constructor/ may differ from + the order of the arguments to the /type constructor/. Example + data T a b where { MkT :: forall c d. (c,d) -> T d c } + f :: T Int Bool -> blah + f (MkT @x @y p) = ... + The /first/ type argument to `MkT`, namely `@x` corresponds to the + /second/ argument to `T` in the type `T Int Bool`. So `x` is bound + to `Bool` -- not to `Int`!. That is why splitConTyArgs uses + conLikeUserTyVarBinders to match up with the user-supplied type arguments + in the pattern, not dataConUnivTyVars/dataConExTyVars. + +(W4) A similar story works for existentials, but it is subtly different + (#19847). Consider + data T a where { MkT :: forall a b. a -> b -> T a } + f :: T Int -> blah + f (MkT @x @y v w) = blah + Here we create a fresh unification variables x0,y0 for x,y and + unify x0~Int, y0~b, where b is the fresh existential variable bound by + the pattern. But + * (x0~Int) must be /outside/ the implication constraint + * (y0~b) must be /inside/ it + (and hence x0 and y0 themselves must have different levels). + Thus: + x0[1]~Int, (forall[2] b. (y0[2]~b, ...constraints-from-blah...)) + + We need (x0~Int) /outside/ so that it can influence the type of the + pattern in an inferred setting, e.g. + g :: T _ -> blah + g (MkT @Int @y v w) = blah + Here we want to infer `g` to have type `T Int -> blah`. If the + (x0~Int) was inside the implication, and the the constructor bound + equality constraints, `x0` would be untouchable. This was the root + cause of #19847. + + We need (y0~b) to be /inside/ the implication, so that `b` is in + scope. In fact, we may actually /need/ equalities bound by the + implication to prove the equality constraint we generate. + Example data T a where + MkT :: forall p q. T (p,q) + f :: T (Int,Bool) -> blah + f (MkT @Int @Bool) = ... + We get the implication + forall[2] p q. (p,q)~(Int,Bool) => (p ~ Int, q ~ Bool, ...) + where the Given comes from the GADT match, while (p~Int, q~Bool) + comes from matching the type arguments. + + Wow. That's all quite subtle! See the long discussion on #19847. We + must treat universal and existential arguments separately, even though + they are all mixed up (W3). The function splitConTyArgs separates the + universals from existentials; and we build the implication between + typechecking the two sets: + tcConTyArgs ... univ_ty_args $ + checkConstraints ... $ + tcConTyArgs ... ex_ty_args $ + ..typecheck body.. + You can see this code shape in tcDataConPat and tcPatSynPat. + + Where pattern synonyms are involved, this two-level split may not be + enough. See #22328 for the story. -} -tcConArgs :: ConLike - -> [Scaled TcSigmaTypeFRR] - -> Subst -- Instantiating substitution for constructor type - -> Checker (HsConPatDetails GhcRn) (HsConPatDetails GhcTc) -tcConArgs con_like arg_tys tenv penv con_args thing_inside = case con_args of +tcConValArgs :: ConLike + -> [Scaled TcSigmaTypeFRR] + -> Checker (HsConPatDetails GhcRn) (HsConPatDetails GhcTc) +tcConValArgs con_like arg_tys penv con_args thing_inside = case con_args of PrefixCon type_args arg_pats -> do + -- NB: type_args already dealt with + -- See Note [Type applications in patterns] { checkTc (con_arity == no_of_args) -- Check correct arity (arityErr (text "constructor") con_like con_arity no_of_args) - -- forgetting to filter out inferred binders led to #20443 - ; let con_spec_binders = filter ((== SpecifiedSpec) . binderFlag) $ - conLikeUserTyVarBinders con_like - ; checkTc (type_args `leLength` con_spec_binders) - (TcRnTooManyTyArgsInConPattern con_like (length con_spec_binders) (length type_args)) - ; let pats_w_tys = zipEqual "tcConArgs" arg_pats arg_tys - ; (type_args', (arg_pats', res)) - <- tcMultiple tcConTyArg penv type_args $ - tcMultiple tcConArg penv pats_w_tys thing_inside - - -- This unification is straight from Figure 7 of - -- "Type Variables in Patterns", Haskell'18 - ; _ <- zipWithM (unifyType Nothing) type_args' (substTyVars tenv $ - binderVars con_spec_binders) - -- OK to drop coercions here. These unifications are all about - -- guiding inference based on a user-written type annotation - -- See Note [Typechecking type applications in patterns] + ; (arg_pats', res) <- tcMultiple tcConArg penv pats_w_tys thing_inside ; return (PrefixCon type_args arg_pats', res) } where @@ -1321,23 +1389,72 @@ tcConArgs con_like arg_tys tenv penv con_args thing_inside = case con_args of -- dataConFieldLabels will be empty (and each field in the pattern -- will generate an error below). -tcConTyArg :: Checker (HsConPatTyArg GhcRn) TcType -tcConTyArg penv (HsConPatTyArg _ rn_ty) thing_inside + +splitConTyArgs :: ConLike -> HsConPatDetails GhcRn + -> TcM ( [(HsConPatTyArg GhcRn, TyVar)] -- Universals + , [(HsConPatTyArg GhcRn, TyVar)] ) -- Existentials +-- See Note [Type applications in patterns] (W4) +-- This function is monadic only because of the error check +-- for too many type arguments +splitConTyArgs con_like (PrefixCon type_args _) + = do { checkTc (type_args `leLength` con_spec_bndrs) + (TcRnTooManyTyArgsInConPattern con_like + (length con_spec_bndrs) (length type_args)) + ; if null ex_tvs -- Short cut common case + then return (bndr_ty_arg_prs, []) + else return (partition is_universal bndr_ty_arg_prs) } + where + ex_tvs = conLikeExTyCoVars con_like + con_spec_bndrs = [ tv | Bndr tv SpecifiedSpec <- conLikeUserTyVarBinders con_like ] + -- conLikeUserTyVarBinders: see (W3) in + -- Note [Type applications in patterns] + -- SpecifiedSpec: forgetting to filter out inferred binders led to #20443 + + bndr_ty_arg_prs = type_args `zip` con_spec_bndrs + -- The zip truncates to length(type_args) + + is_universal (_, tv) = not (tv `elem` ex_tvs) + -- See Note [DataCon user type variable binders] in GHC.Core.DataCon + -- especially INVARIANT(dataConTyVars). + +splitConTyArgs _ (RecCon {}) = return ([], []) -- No type args in RecCon +splitConTyArgs _ (InfixCon {}) = return ([], []) -- No type args in InfixCon + +tcConTyArgs :: Subst -> PatEnv -> [(HsConPatTyArg GhcRn, TyVar)] + -> TcM a -> TcM a +tcConTyArgs tenv penv prs thing_inside + = tcMultiple_ (tcConTyArg tenv) penv prs thing_inside + +tcConTyArg :: Subst -> Checker (HsConPatTyArg GhcRn, TyVar) () +tcConTyArg tenv penv (HsConPatTyArg _ rn_ty, con_tv) thing_inside = do { (sig_wcs, sig_ibs, arg_ty) <- tcHsPatSigType TypeAppCtxt HM_TyAppPat rn_ty AnyKind -- AnyKind is a bit suspect: it really should be the kind gotten -- from instantiating the constructor type. But this would be -- hard to get right, because earlier type patterns might influence -- the kinds of later patterns. In any case, it all gets checked - -- by the calls to unifyType in tcConArgs, which will also unify - -- kinds. + -- by the calls to unifyType below which unifies kinds + ; case NE.nonEmpty sig_ibs of Just sig_ibs_ne | inPatBind penv -> addErr (TcRnCannotBindTyVarsInPatBind sig_ibs_ne) _ -> pure () + + -- This unification is straight from Figure 7 of + -- "Type Variables in Patterns", Haskell'18 + -- OK to drop coercions here. These unifications are all about + -- guiding inference based on a user-written type annotation + -- See Note [Type applications in patterns] (W1) + ; _ <- unifyType Nothing arg_ty (substTyVar tenv con_tv) + ; result <- tcExtendNameTyVarEnv sig_wcs $ tcExtendNameTyVarEnv sig_ibs $ thing_inside - ; return (arg_ty, result) } + -- NB: Because we call tConTyArgs twice, once for universals and + -- once for existentials; so this brings things into scope + -- "out of left-right order". But it doesn't matter; the renamer + -- has dealt with all that. + + ; return ((), result) } tcConArg :: Checker (LPat GhcRn, Scaled TcSigmaType) (LPat GhcTc) tcConArg penv (arg_pat, Scaled arg_mult arg_ty) ===================================== testsuite/tests/gadt/T19847.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE GADTs, PatternSynonyms, ViewPatterns, ScopedTypeVariables #-} + +module T19847 where + +import Data.Kind +import Type.Reflection + +pattern Is :: forall (b :: Type) (a :: Type). Typeable b => (a ~ b) => TypeRep a +pattern Is <- (eqTypeRep (typeRep @b) -> Just HRefl) + where Is = typeRep + +def :: TypeRep a -> a +def x = case x of + Is @Int -> 10 + Is @Bool -> False ===================================== testsuite/tests/gadt/T19847a.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE LambdaCase, GADTs, ScopedTypeVariables, TypeAbstractions #-} + +module T19847a where + +data T a b c where + MkT :: forall c y x b. (x~y, c~[x], Ord x) => x -> y -> T (x,y) b c + +f :: forall b c. (T (Int,Int) b c -> Bool) -> (b,c) +f = error "urk" + +h = f (\case { MkT @_ @_ @_ @Int p q -> True }) +-- Check that the @Int argument can affect +-- the type at which `f` is instantiated +-- So h :: forall c. (Int,c) ===================================== testsuite/tests/gadt/T19847a.stderr ===================================== @@ -0,0 +1,12 @@ +TYPE SIGNATURES + f :: forall b c. (T (Int, Int) b c -> Bool) -> (b, c) + h :: forall {c}. (Int, c) +TYPE CONSTRUCTORS + data type T{4} :: forall {k}. * -> k -> * -> * + roles nominal nominal phantom nominal +DATA CONSTRUCTORS + MkT :: forall {k} c y x (b :: k). + (x ~ y, c ~ [x], Ord x) => + x -> y -> T (x, y) b c +Dependent modules: [] +Dependent packages: [base-4.18.0.0] ===================================== testsuite/tests/gadt/T19847b.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeAbstractions, GADTs #-} + +module T19847b where + +import Data.Kind + +data T (a :: Type) b where + MkT4 :: forall a b. b ~ a => T a b + +foo x = (case x of MkT4 @Bool -> ()) :: () ===================================== testsuite/tests/gadt/all.T ===================================== @@ -126,3 +126,6 @@ test('SynDataRec', normal, compile, ['']) test('T20485', normal, compile, ['']) test('T20485a', normal, compile, ['']) test('T22235', normal, compile, ['']) +test('T19847', normal, compile, ['']) +test('T19847a', normal, compile, ['-ddump-types']) +test('T19847b', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_compile/T19577.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RankNTypes #-} + +module T19577 where + +data SBool (b :: Bool) where + STrue :: forall b. (b ~ 'True) => SBool b + SFalse :: forall b. (b ~ 'False) => SBool b + +class Blah b where + blah :: SBool b + +instance Blah 'True where + blah = STrue + +foo :: Blah b => (SBool b -> Int) -> Int +foo f = f blah + +bar = foo (\(STrue @True) -> 42) ===================================== testsuite/tests/typecheck/should_compile/T21501.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE MonoLocalBinds, PatternSynonyms, ViewPatterns, TypeAbstractions #-} + +module T21501 where + +import Data.Kind +import Type.Reflection + +pattern TypeApp :: + forall {k1} {k2} (f :: k1 -> k2) (result :: k2). + Typeable f => + forall (arg :: k1). + result ~ f arg => + TypeRep arg -> + TypeRep result +pattern TypeApp arg_rep <- App (eqTypeRep (typeRep @f) -> Just HRefl) arg_rep + +f :: TypeRep (a :: Type) -> String +f (TypeApp @[] rep) = show rep + +{- Expected type: TypeRep k (a::k) + Instantiate at k10 k20 (f0 :: k10 -> k20) (result0 :: k20) + Unify (TypeRep k (a::k) ~ TypeRep k20 (result :: k20) + Unify f0 ~ [] +-} ===================================== testsuite/tests/typecheck/should_compile/T22383.hs ===================================== @@ -0,0 +1,83 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase, ScopedTypeVariables #-} + +module T22383 where + +import Data.Kind (Type) +import Data.Proxy (Proxy(Proxy)) + +-- | @IsType k@ witnesses that @k ~ Type at . +data IsType k where + IsType :: IsType Type + +--------------------- +-- Using a GADT +--------------------- + +data FromType where + FromType :: forall (f :: Type -> Type). FromType + +-- | @FunRep (f b)@ witnesses that @b :: Type at . +data FunRep a where + AppK :: + forall (k :: Type) (f :: k -> Type) (b :: k). + IsType k -> + Proxy f -> + FunRep (f b) + +-- Could not deduce: k ~ * +isMaybeF :: forall (a :: Type). FunRep a -> FromType +isMaybeF = \case + AppK @_ @f @_ t (Proxy @g :: Proxy h) -> + case t of + IsType -> FromType @f + +-- Could not deduce: k ~ * +isMaybeG :: forall (a :: Type). FunRep a -> FromType +isMaybeG = \case + AppK @_ @f @_ t (Proxy @g :: Proxy h) -> + case t of + IsType -> FromType @g + +-- Works fine +isMaybeH :: forall (a :: Type). FunRep a -> FromType +isMaybeH = \case + AppK @_ @f @_ t (Proxy @g :: Proxy h) -> + case t of + IsType -> FromType @h + + +--------------------- +-- Not using a GADT +--------------------- + +data FunRep2 a where + AppK2 :: + forall k (b :: k). + IsType k -> + Proxy k -> + FunRep2 b + +data FromType2 where + FromType2 :: forall (b :: Type). FromType2 + +-- Could not deduce: k ~ * +isMaybeF2 :: forall k (a :: k). FunRep2 a -> FromType2 +isMaybeF2 = \case + AppK2 @_ @f t (Proxy @g :: Proxy h) -> + case t of + IsType -> FromType2 @f + +-- Works fine +isMaybeG2 :: forall k (a :: k). FunRep2 a -> FromType2 +isMaybeG2 = \case + AppK2 @_ @f t (Proxy @g :: Proxy h) -> + case t of + IsType -> FromType2 @g + +-- Works fine +isMaybeH2 :: forall k (a :: k). FunRep2 a -> FromType2 +isMaybeH2 = \case + AppK2 @_ @f t (Proxy @g :: Proxy h) -> + case t of + IsType -> FromType2 @h ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -854,3 +854,6 @@ test('T22310', normal, compile, ['']) test('T22331', normal, compile, ['']) test('T22516', normal, compile, ['']) test('T22647', normal, compile, ['']) +test('T19577', normal, compile, ['']) +test('T22383', normal, compile, ['']) +test('T21501', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f95db54e38b21782d058043abe42fd77abfb9ad -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f95db54e38b21782d058043abe42fd77abfb9ad You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 1 17:31:42 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 01 Feb 2023 12:31:42 -0500 Subject: [Git][ghc/ghc][master] Treat existentials correctly in dubiousDataConInstArgTys Message-ID: <63daa1fe1741c_2a4fa049e44143797f@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 3 changed files: - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - + testsuite/tests/simplCore/should_compile/T22849.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -707,7 +707,7 @@ Worker/wrapper will unbox * is an algebraic data type (not a newtype) * is not recursive (as per 'isRecDataCon') * has a single constructor (thus is a "product") - * that may bind existentials + * that may bind existentials (#18982) We can transform > data D a = forall b. D a b > f (D @ex a b) = e @@ -1272,16 +1272,25 @@ also unbox its components. That is governed by the `usefulSplit` mechanism. -} -- | Exactly 'dataConInstArgTys', but lacks the (ASSERT'ed) precondition that --- the 'DataCon' may not have existentials. The lack of cloning the existentials --- compared to 'dataConInstExAndArgVars' makes this function \"dubious\"; --- only use it where type variables aren't substituted for! +-- the 'DataCon' may not have existentials. The lack of cloning the +-- existentials this function \"dubious\"; only use it where type variables +-- aren't substituted for! Why may the data con bind existentials? +-- See Note [Which types are unboxed?] dubiousDataConInstArgTys :: DataCon -> [Type] -> [Type] dubiousDataConInstArgTys dc tc_args = arg_tys where - univ_tvs = dataConUnivTyVars dc - ex_tvs = dataConExTyCoVars dc - subst = extendSubstInScopeList (zipTvSubst univ_tvs tc_args) ex_tvs - arg_tys = map (GHC.Core.Type.substTy subst . scaledThing) (dataConRepArgTys dc) + univ_tvs = dataConUnivTyVars dc + ex_tvs = dataConExTyCoVars dc + univ_subst = zipTvSubst univ_tvs tc_args + (full_subst, _) = substTyVarBndrs univ_subst ex_tvs + arg_tys = map (substTy full_subst . scaledThing) $ + dataConRepArgTys dc + -- NB: use substTyVarBndrs on ex_tvs to ensure that we + -- substitute in their kinds. For example (#22849) + -- Consider data T a where + -- MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a + -- Then dubiousDataConInstArgTys MkT [Type, Foo] should return + -- [Foo (ix::Type)], not [Foo (ix::k)]! findTypeShape :: FamInstEnvs -> Type -> TypeShape -- Uncover the arrow and product shape of a type ===================================== testsuite/tests/simplCore/should_compile/T22849.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE GADTs #-} + +module T22849 where + +data Foo a where + Foo :: Foo Int + +data Bar a = Bar a (Foo a) + +data Some t = forall ix. Some (t ix) + +instance Show (Some Bar) where + show (Some (Bar v t)) = case t of + Foo -> show v ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -453,7 +453,7 @@ test('T22375', normal, compile, ['-O -ddump-simpl -dsuppress-uniques -dno-typeab test('T21851_2', [grep_errmsg(r'wwombat') ], multimod_compile, ['T21851_2', '-O -dno-typeable-binds -dsuppress-uniques']) # Should not inline m, so there shouldn't be a single YES test('T22317', [grep_errmsg(r'ANSWER = YES') ], compile, ['-O -dinline-check m -ddebug-output']) - +test('T22849', normal, compile, ['-O']) test('T22634', normal, compile, ['-O -fcatch-nonexhaustive-cases']) test('T22494', [grep_errmsg(r'case') ], compile, ['-O -ddump-simpl -dsuppress-uniques']) test('T22491', normal, compile, ['-O2']) @@ -472,3 +472,4 @@ test('T22611', [when(wordsize(32), skip), grep_errmsg(r'\$salterF') ], compile, test('T22715_2', normal, multimod_compile, ['T22715_2', '-v0 -O -fspecialise-aggressively']) test('T22802', normal, compile, ['-O']) test('T15205', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/955a99ea28a0d06de67f0595d366450281aab0c0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/955a99ea28a0d06de67f0595d366450281aab0c0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 1 17:32:24 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 01 Feb 2023 12:32:24 -0500 Subject: [Git][ghc/ghc][master] 2 commits: Bump supported LLVM range from 10 through 15 to 11 through 16 Message-ID: <63daa228e0988_2a4f2e64f888144383f@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 3 changed files: - .gitlab-ci.yml - configure.ac - llvm-passes 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: 2d59d551647d102c4af44f257c520a94f04ea3f6 + DOCKER_REV: 572353e0644044fe3a5465bba4342a9a0b0eb60e # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. ===================================== configure.ac ===================================== @@ -554,8 +554,8 @@ AC_SUBST(InstallNameToolCmd) # tools we are looking for. In the past, GHC supported a number of # versions of LLVM simultaneously, but that stopped working around # 3.5/3.6 release of LLVM. -LlvmMinVersion=10 # inclusive -LlvmMaxVersion=15 # not inclusive +LlvmMinVersion=11 # inclusive +LlvmMaxVersion=16 # not inclusive AC_SUBST([LlvmMinVersion]) AC_SUBST([LlvmMaxVersion]) sUPPORTED_LLVM_VERSION_MIN=$(echo \($LlvmMinVersion\) | sed 's/\./,/') ===================================== llvm-passes ===================================== @@ -1,5 +1,5 @@ [ -(0, "-mem2reg -globalopt -lower-expect"), -(1, "-O1 -globalopt"), -(2, "-O2") +(0, "-enable-new-pm=0 -mem2reg -globalopt -lower-expect"), +(1, "-enable-new-pm=0 -O1 -globalopt"), +(2, "-enable-new-pm=0 -O2") ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/955a99ea28a0d06de67f0595d366450281aab0c0...f94f14502a00824d48cef69d362774a9a4bfc6d6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/955a99ea28a0d06de67f0595d366450281aab0c0...f94f14502a00824d48cef69d362774a9a4bfc6d6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 1 18:42:56 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 01 Feb 2023 13:42:56 -0500 Subject: [Git][ghc/ghc][wip/fix-notes] 1625 commits: hi haddock: Lex and store haddock docs in interface files Message-ID: <63dab2b0a4d51_2a4f55fdc14561e1@gitlab.mail> Ben Gamari pushed to branch wip/fix-notes at Glasgow Haskell Compiler / GHC Commits: b91798be by Zubin Duggal at 2022-03-23T13:39:39-04:00 hi haddock: Lex and store haddock docs in interface files Names appearing in Haddock docstrings are lexed and renamed like any other names appearing in the AST. We currently rename names irrespective of the namespace, so both type and constructor names corresponding to an identifier will appear in the docstring. Haddock will select a given name as the link destination based on its own heuristics. This patch also restricts the limitation of `-haddock` being incompatible with `Opt_KeepRawTokenStream`. The export and documenation structure is now computed in GHC and serialised in .hi files. This can be used by haddock to directly generate doc pages without reparsing or renaming the source. At the moment the operation of haddock is not modified, that's left to a future patch. Updates the haddock submodule with the minimum changes needed. - - - - - 78db231f by Cheng Shao at 2022-03-23T13:40:17-04:00 configure: bump LlvmMaxVersion to 14 LLVM 13.0.0 is released in Oct 2021, and latest head validates against LLVM 13 just fine if LlvmMaxVersion is bumped. - - - - - b06e5dd8 by Adam Sandberg Ericsson at 2022-03-23T13:40:54-04:00 docs: clarify the eventlog format documentation a little bit - - - - - 4dc62498 by Matthew Pickering at 2022-03-23T13:41:31-04:00 Fix behaviour of -Wunused-packages in ghci Ticket #21110 points out that -Wunused-packages behaves a bit unusually in GHCi. Now we define the semantics for -Wunused-packages in interactive mode as follows: * If you use -Wunused-packages on an initial load then the warning is reported. * If you explicitly set -Wunused-packages on the command line then the warning is displayed (until it is disabled) * If you then subsequently modify the set of available targets by using :load or :cd (:cd unloads everything) then the warning is (silently) turned off. This means that every :r the warning is printed if it's turned on (but you did ask for it). Fixes #21110 - - - - - fed05347 by Ben Gamari at 2022-03-23T13:42:07-04:00 rts/adjustor: Place adjustor templates in data section on all OSs In !7604 we started placing adjustor templates in the data section on Linux as some toolchains there reject relocations in the text section. However, it turns out that OpenBSD also exhibits this restriction. Fix this by *always* placing adjustor templates in the data section. Fixes #21155. - - - - - db32bb8c by Zubin Duggal at 2022-03-23T13:42:44-04:00 Improve error message when warning about unsupported LLVM version (#20958) Change the wording to make it clear that the upper bound is non-inclusive. - - - - - f214349a by Ben Gamari at 2022-03-23T13:43:20-04:00 rts: Untag function field in scavenge_PAP_payload Previously we failed to untag the function closure when scavenging the payload of a PAP, resulting in an invalid closure pointer being passed to scavenge_large_bitmap and consequently #21254. Fix this. Fixes #21254 - - - - - e6d0e287 by Ben Gamari at 2022-03-23T13:43:20-04:00 rts: Don't mark object code in markCAFs unless necessary Previously `markCAFs` would call `markObjectCode` even in non-major GCs. This is problematic since `prepareUnloadCheck` is not called in such GCs, meaning that the section index has not been updated. Fixes #21254 - - - - - 1a7cf096 by Sylvain Henry at 2022-03-23T13:44:05-04:00 Avoid redundant imports of GHC.Driver.Session Remove GHC.Driver.Session imports that weren't considered as redundant because of the reexport of PlatformConstants. Also remove this reexport as modules using this datatype should import GHC.Platform instead. - - - - - e3f60577 by Sylvain Henry at 2022-03-23T13:44:05-04:00 Reverse dependency between StgToCmm and Runtime.Heap.Layout - - - - - e6585ca1 by Sylvain Henry at 2022-03-23T13:44:46-04:00 Define filterOut with filter filter has fusion rules that filterOut lacks - - - - - c58d008c by Ryan Scott at 2022-03-24T06:10:43-04:00 Fix and simplify DeriveAnyClass's context inference using SubTypePredSpec As explained in `Note [Gathering and simplifying constraints for DeriveAnyClass]` in `GHC.Tc.Deriv.Infer`, `DeriveAnyClass` infers instance contexts by emitting implication constraints. Previously, these implication constraints were constructed by hand. This is a terribly trick thing to get right, as it involves a delicate interplay of skolemisation, metavariable instantiation, and `TcLevel` bumping. Despite much effort, we discovered in #20719 that the implementation was subtly incorrect, leading to valid programs being rejected. While we could scrutinize the code that manually constructs implication constraints and repair it, there is a better, less error-prone way to do things. After all, the heart of `DeriveAnyClass` is generating code which fills in each class method with defaults, e.g., `foo = $gdm_foo`. Typechecking this sort of code is tantamount to calling `tcSubTypeSigma`, as we much ensure that the type of `$gdm_foo` is a subtype of (i.e., more polymorphic than) the type of `foo`. As an added bonus, `tcSubTypeSigma` is a battle-tested function that handles skolemisation, metvariable instantiation, `TcLevel` bumping, and all other means of tricky bookkeeping correctly. With this insight, the solution to the problems uncovered in #20719 is simple: use `tcSubTypeSigma` to check if `$gdm_foo`'s type is a subtype of `foo`'s type. As a side effect, `tcSubTypeSigma` will emit exactly the implication constraint that we were attempting to construct by hand previously. Moreover, it does so correctly, fixing #20719 as a consequence. This patch implements the solution thusly: * The `PredSpec` data type (previously named `PredOrigin`) is now split into `SimplePredSpec`, which directly stores a `PredType`, and `SubTypePredSpec`, which stores the actual and expected types in a subtype check. `SubTypePredSpec` is only used for `DeriveAnyClass`; all other deriving strategies use `SimplePredSpec`. * Because `tcSubTypeSigma` manages the finer details of type variable instantiation and constraint solving under the hood, there is no longer any need to delicately split apart the method type signatures in `inferConstraintsAnyclass`. This greatly simplifies the implementation of `inferConstraintsAnyclass` and obviates the need to store skolems, metavariables, or given constraints in a `ThetaSpec` (previously named `ThetaOrigin`). As a bonus, this means that `ThetaSpec` now simply becomes a synonym for a list of `PredSpec`s, which is conceptually much simpler than it was before. * In `simplifyDeriv`, each `SubTypePredSpec` results in a call to `tcSubTypeSigma`. This is only performed for its side effect of emitting an implication constraint, which is fed to the rest of the constraint solving machinery in `simplifyDeriv`. I have updated `Note [Gathering and simplifying constraints for DeriveAnyClass]` to explain this in more detail. To make the changes in `simplifyDeriv` more manageable, I also performed some auxiliary refactoring: * Previously, every iteration of `simplifyDeriv` was skolemising the type variables at the start, simplifying, and then performing a reverse substitution at the end to un-skolemise the type variables. This is not necessary, however, since we can just as well skolemise once at the beginning of the `deriving` pipeline and zonk the `TcTyVar`s after `simplifyDeriv` is finished. This patch does just that, having been made possible by prior work in !7613. I have updated `Note [Overlap and deriving]` in `GHC.Tc.Deriv.Infer` to explain this, and I have also left comments on the relevant data structures (e.g., `DerivEnv` and `DerivSpec`) to explain when things might be `TcTyVar`s or `TyVar`s. * All of the aforementioned cleanup allowed me to remove an ad hoc deriving-related in `checkImplicationInvariants`, as all of the skolems in a `tcSubTypeSigma`–produced implication constraint should now be `TcTyVar` at the time the implication is created. * Since `simplifyDeriv` now needs a `SkolemInfo` and `UserTypeCtxt`, I have added `ds_skol_info` and `ds_user_ctxt` fields to `DerivSpec` to store these. Similarly, I have also added a `denv_skol_info` field to `DerivEnv`, which ultimately gets used to initialize the `ds_skol_info` in a `DerivSpec`. Fixes #20719. - - - - - 21680fb0 by Sebastian Graf at 2022-03-24T06:11:19-04:00 WorkWrap: Handle partial FUN apps in `isRecDataCon` (#21265) Partial FUN apps like `(->) Bool` aren't detected by `splitFunTy_maybe`. A silly oversight that is easily fixed by replacing `splitFunTy_maybe` with a guard in the `splitTyConApp_maybe` case. But fortunately, Simon nudged me into rewriting the whole `isRecDataCon` function in a way that makes it much shorter and hence clearer which DataCons are actually considered as recursive. Fixes #21265. - - - - - a2937e2b by Matthew Pickering at 2022-03-24T17:13:22-04:00 Add test for T21035 This test checks that you are allowed to explicitly supply object files for dependencies even if you haven't got the shared object for that library yet. Fixes #21035 - - - - - 1756d547 by Matthew Pickering at 2022-03-24T17:13:58-04:00 Add check to ensure we are not building validate jobs for releases - - - - - 99623358 by Matthew Pickering at 2022-03-24T17:13:58-04:00 hadrian: Correct generation of hsc2hs wrapper If you inspect the inside of a wrapper script for hsc2hs you will see that the cflag and lflag values are concatenated incorrectly. ``` HSC2HS_EXTRA="--cflag=-U__i686--lflag=-fuse-ld=gold" ``` It should instead be ``` HSC2HS_EXTRA="--cflag=-U__i686 --lflag=-fuse-ld=gold" ``` Fixes #21221 - - - - - fefd4e31 by Matthew Pickering at 2022-03-24T17:13:59-04:00 testsuite: Remove library dependenices from T21119 These dependencies would affect the demand signature depending on various rules and so on. Fixes #21271 - - - - - 5ff690b8 by Matthew Pickering at 2022-03-24T17:13:59-04:00 ci: Generate jobs for all normal builds and use hadrian for all builds This commit introduces a new script (.gitlab/gen_ci.hs) which generates a yaml file (.gitlab/jobs.yaml) which contains explicit descriptions for all the jobs we want to run. The jobs are separated into three categories: * validate - jobs run on every MR * nightly - jobs run once per day on the master branch * release - jobs for producing release artifacts The generation script is a Haskell program which includes a DSL for specifying the different jobs. The hope is that it's easier to reason about the different jobs and how the variables are merged together rather than the unclear and opaque yaml syntax. The goal is to fix issues like #21190 once and for all.. The `.gitlab/jobs.yaml` can be generated by running the `.gitlab/generate_jobs` script. You have to do this manually. Another consequence of this patch is that we use hadrian for all the validate, nightly and release builds on all platforms. - - - - - 1d673aa2 by Christiaan Baaij at 2022-03-25T11:35:49-04:00 Add the OPAQUE pragma A new pragma, `OPAQUE`, that ensures that every call of a named function annotated with an `OPAQUE` pragma remains a call of that named function, not some name-mangled variant. Implements GHC proposal 0415: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0415-opaque-pragma.rst This commit also updates the haddock submodule to handle the newly introduced lexer tokens corresponding to the OPAQUE pragma. - - - - - 83f5841b by Bodigrim at 2022-03-25T11:36:31-04:00 Add instance Lift ByteArray - - - - - 7cc1184a by Matthew Pickering at 2022-03-25T11:37:07-04:00 Make -ddump-rn-ast and -ddump-tc-ast work in GHCi Fixes #17830 - - - - - 940feaf3 by Sylvain Henry at 2022-03-25T11:37:47-04:00 Modularize Tidy (#17957) - Factorize Tidy options into TidyOpts datatype. Initialize it in GHC.Driver.Config.Tidy - Same thing for StaticPtrOpts - Perform lookups of unpackCString[Utf8]# once in initStaticPtrOpts instead of for every use of mkStringExprWithFS - - - - - 25101813 by Takenobu Tani at 2022-03-28T01:16:02-04:00 users-guide: Correct markdown for profiling This patch corrects some markdown. [skip ci] - - - - - c832ae93 by Matthew Pickering at 2022-03-28T01:16:38-04:00 hadrian: Flag cabal flag handling This patch basically deletes some ad-hoc handling of Cabal Flags and replaces it with a correct query of the LocalBuildInfo. The flags in the local build info can be modified by users by passing hadrian options For example (!4331) ``` *.genapply.cabal.configure.opts += --flags=unregisterised ``` And all the flags specified by the `Cabal Flags` builder were already passed to configure properly using `--flags`. - - - - - a9f3a5c6 by Ben Gamari at 2022-03-28T01:16:38-04:00 Disable text's dependency on simdutf by default Unfortunately we are simply not currently in a good position to robustly ship binary distributions which link against C++ code like simdutf. Fixes #20724. - - - - - eff86e8a by Richard Eisenberg at 2022-03-28T01:17:14-04:00 Add Red Herring to Note [What might equal later?] Close #21208. - - - - - 12653be9 by jberryman at 2022-03-28T01:17:55-04:00 Document typed splices inhibiting unused bind detection (#16524) - - - - - 4aeade15 by Adam Sandberg Ericsson at 2022-03-28T01:18:31-04:00 users-guide: group ticky-ticky profiling under one heading - - - - - cc59648a by Sylvain Henry at 2022-03-28T01:19:12-04:00 Hadrian: allow testsuite to run with cross-compilers (#21292) - - - - - 89cb1315 by Matthew Pickering at 2022-03-28T01:19:48-04:00 hadrian: Add show target to bindist makefile Some build systems use "make show" to query facts about the bindist, for example: ``` make show VALUE=ProjectVersion > version ``` to determine the ProjectVersion - - - - - 8229885c by Alan Zimmerman at 2022-03-28T19:23:28-04:00 EPA: let stmt with semicolon has wrong anchor The code let ;x =1 Captures the semicolon annotation, but did not widen the anchor in the ValBinds. Fix that. Closes #20247 - - - - - 2c12627c by Ryan Scott at 2022-03-28T19:24:04-04:00 Consistently attach SrcSpans to sub-expressions in TH splices Before, `GHC.ThToHs` was very inconsistent about where various sub-expressions would get the same `SrcSpan` from the original TH splice location or just a generic `noLoc` `SrcSpan`. I have ripped out all uses of `noLoc` in favor of the former instead, and I have added a `Note [Source locations within TH splices]` to officially enshrine this design choice. Fixes #21299. - - - - - 789add55 by Zubin Duggal at 2022-03-29T13:07:22-04:00 Fix all invalid haddock comments in the compiler Fixes #20935 and #20924 - - - - - 967dad03 by Zubin Duggal at 2022-03-29T13:07:22-04:00 hadrian: Build lib:GHC with -haddock and -Winvalid-haddock (#21273) - - - - - ad09a5f7 by sheaf at 2022-03-29T13:08:05-04:00 Hadrian: make DDEBUG separate from debugged RTS This patchs separates whether -DDEBUG is enabled (i.e. whether debug assertions are enabled) from whether we are using the debugged RTS (i.e. GhcDebugged = YES). This means that we properly skip tests which have been marked with `when(compiler_debugged(), skip)`. Fixes #21113, #21153 and #21234 - - - - - 840a6811 by Matthew Pickering at 2022-03-29T13:08:42-04:00 RTS: Zero gc_cpu_start and gc_cpu_end after accounting When passed a combination of `-N` and `-qn` options the cpu time for garbage collection was being vastly overcounted because the counters were not being zeroed appropiately. When -qn1 is passed, only 1 of the N avaiable GC threads is chosen to perform work, the rest are idle. At the end of the GC period, stat_endGC traverses all the GC threads and adds up the elapsed time from each of them. For threads which didn't participate in this GC, the value of the cpu time should be zero, but before this patch, the counters were not zeroed and hence we would count the same elapsed time on many subsequent iterations (until the thread participated in a GC again). The most direct way to zero these fields is to do so immediately after the value is added into the global counter, after which point they are never used again. We also tried another approach where we would zero the counter in yieldCapability but there are some (undiagnosed) siations where a capbility would not pass through yieldCapability before the GC ended and the same double counting problem would occur. Fixes #21082 - - - - - dda46e2d by Matthew Pickering at 2022-03-29T13:09:18-04:00 Add test for T21306 Fixes #21306 - - - - - f07c7766 by Jakob Brünker at 2022-03-30T03:10:33-04:00 Give parsing plugins access to errors Previously, when the parser produced non-fatal errors (i.e. it produced errors but the 'PState' is 'POk'), compilation would be aborted before the 'parsedResultAction' of any plugin was invoked. This commit changes that, so that such that 'parsedResultAction' gets collections of warnings and errors as argument, and must return them after potentially modifying them. Closes #20803 - - - - - e5dfde75 by Ben Gamari at 2022-03-30T03:11:10-04:00 Fix reference to Note [FunBind vs PatBind] This Note was renamed in 2535a6716202253df74d8190b028f85cc6d21b72 yet this occurrence was not updated. - - - - - 21894a63 by Krzysztof Gogolewski at 2022-03-30T03:11:45-04:00 Refactor: make primtypes independent of PrimReps Previously, 'pcPrimTyCon', the function used to define a primitive type, was taking a PrimRep, only to convert it to a RuntimeRep. Now it takes a RuntimeRep directly. Moved primRepToRuntimeRep to GHC.Types.RepType. It is now located next to its inverse function runtimeRepPrimRep. Now GHC.Builtin.Types.Prim no longer mentions PrimRep, and GHC.Types.RepType no longer imports GHC.Builtin.Types.Prim. Removed unused functions `primRepsToRuntimeRep` and `mkTupleRep`. Removed Note [PrimRep and kindPrimRep] - it was never referenced, didn't belong to Types.Prim, and Note [Getting from RuntimeRep to PrimRep] is more comprehensive. - - - - - 43da2963 by Matthew Pickering at 2022-03-30T09:55:49+01:00 Fix mention of non-existent "rehydrateIface" function [skip ci] Fixes #21303 - - - - - 6793a20f by gershomb at 2022-04-01T10:33:46+01:00 Remove wrong claim about naturality law. This docs change removes a longstanding confusion in the Traversable docs. The docs say "(The naturality law is implied by parametricity and thus so is the purity law [1, p15].)". However if one reads the reference a different "natural" law is implied by parametricity. The naturality law given as a law here is imposed. Further, the reference gives examples which violate both laws -- so they cannot be implied by parametricity. This PR just removes the wrong claim. - - - - - 5beeff46 by Ben Gamari at 2022-04-01T10:34:39+01:00 Refactor handling of global initializers GHC uses global initializers for a number of things including cost-center registration, info-table provenance registration, and setup of foreign exports. Previously, the global initializer arrays which referenced these initializers would live in the object file of the C stub, which would then be merged into the main object file of the module. Unfortunately, this approach is no longer tenable with the move to Clang/LLVM on Windows (see #21019). Specifically, lld's PE backend does not support object merging (that is, the -r flag). Instead we are now rather packaging a module's object files into a static library. However, this is problematic in the case of initializers as there are no references to the C stub object in the archive, meaning that the linker may drop the object from the final link. This patch refactors our handling of global initializers to instead place initializer arrays within the object file of the module to which they belong. We do this by introducing a Cmm data declaration containing the initializer array in the module's Cmm stream. While the initializer functions themselves remain in separate C stub objects, the reference from the module's object ensures that they are not dropped from the final link. In service of #21068. - - - - - 3e6fe71b by Matthew Pickering at 2022-04-01T10:35:41+01:00 Fix remaining issues in eventlog types (gen_event_types.py) * The size of End concurrent mark phase looks wrong and, it used to be 4 and now it's 0. * The size of Task create is wrong, used to be 18 and now 14. * The event ticky-ticky entry counter begin sample has the wrong name * The event ticky-ticky entry counter being sample has the wrong size, was 0 now 32. Closes #21070 - - - - - 7847f47a by Ben Gamari at 2022-04-01T10:35:41+01:00 users-guide: Fix a few small issues in eventlog format descriptions The CONC_MARK_END event description didn't mention its payload. Clarify the meaning of the CREATE_TASK's payload. - - - - - acfd5a4c by Matthew Pickering at 2022-04-01T10:35:53+01:00 ci: Regenerate jobs.yaml It seems I forgot to update this to reflect the current state of gen_ci.hs - - - - - a952dd80 by Matthew Pickering at 2022-04-01T10:35:59+01:00 ci: Attempt to fix windows cache issues It appears that running the script directly does nothing (no info is printed about saving the cache). - - - - - fb65e6e3 by Adrian Ratiu at 2022-04-01T10:49:52+01:00 fp_prog_ar.m4: take AR var into consideration In ChromeOS and Gentoo we want the ability to use LLVM ar instead of GNU ar even though both are installed, thus we pass (for eg) AR=llvm-ar to configure. Unfortunately GNU ar always gets picked regardless of the AR setting because the check does not consider the AR var when setting fp_prog_ar, hence this fix. - - - - - 1daaefdf by Greg Steuck at 2022-04-01T10:50:16+01:00 T13366 requires c++ & c++abi libraries on OpenBSD Fixes this failure: =====> 1 of 1 [0, 0, 0] T13366(normal) 1 of 1 [0, 0, 0] Compile failed (exit code 1) errors were: <no location info>: error: user specified .o/.so/.DLL could not be loaded (File not found) Whilst trying to load: (dynamic) stdc++ Additional directories searched: (none) *** unexpected failure for T13366(normal) - - - - - 18e6c85b by Jakob Bruenker at 2022-04-01T10:54:28+01:00 new datatypes for parsedResultAction Previously, the warnings and errors were given and returned as a tuple (Messages PsWarnings, Messages PsErrors). Now, it's just PsMessages. This, together with the HsParsedModule the parser plugin gets and returns, has been wrapped up as ParsedResult. - - - - - 9727e592 by Morrow at 2022-04-01T10:55:12+01:00 Clarify that runghc interprets the input program - - - - - f589dea3 by sheaf at 2022-04-01T10:59:58+01:00 Unify RuntimeRep arguments in ty_co_match The `ty_co_match` function ignored the implicit RuntimeRep coercions that occur in a `FunCo`. Even though a comment explained that this should be fine, #21205 showed that it could result in discarding a RuntimeRep coercion, and thus discarding an important cast entirely. With this patch, we first match the kinds in `ty_co_match`. Fixes #21205 ------------------------- Metric Increase: T12227 T18223 ------------------------- - - - - - 6f4dc372 by Andreas Klebinger at 2022-04-01T11:01:35+01:00 Export MutableByteArray from Data.Array.Byte This implements CLC proposal #49 - - - - - 5df9f5e7 by ARATA Mizuki at 2022-04-01T11:02:35+01:00 Add test cases for #20640 Closes #20640 - - - - - 8334ff9e by Krzysztof Gogolewski at 2022-04-01T11:03:16+01:00 Minor cleanup - Remove unused functions exprToCoercion_maybe, applyTypeToArg, typeMonoPrimRep_maybe, runtimeRepMonoPrimRep_maybe. - Replace orValid with a simpler check - Use splitAtList in applyTysX - Remove calls to extra_clean in the testsuite; it does not do anything. Metric Decrease: T18223 - - - - - b2785cfc by Eric Lindblad at 2022-04-01T11:04:07+01:00 hadrian typos - - - - - 418e6fab by Eric Lindblad at 2022-04-01T11:04:12+01:00 two typos - - - - - dd7c7c99 by Phil de Joux at 2022-04-01T11:04:56+01:00 Add tests and docs on plugin args and order. - - - - - 3e209a62 by MaxHearnden at 2022-04-01T11:05:19+01:00 Change may not to might not - - - - - b84380d3 by Matthew Pickering at 2022-04-01T11:07:27+01:00 hadrian: Remove linters-common from bindist Zubin observed that the bindists contains the utility library linters-common. There are two options: 1. Make sure only the right files are added into the bindist.. a bit tricky due to the non-trivial structure of the lib directory. 2. Remove the bad files once they get copied in.. a bit easier So I went for option 2 but we perhaps should go for option 1 in the future. Fixes #21203 - - - - - ba9904c1 by Zubin Duggal at 2022-04-01T11:07:31+01:00 hadrian: allow testing linters with out of tree compilers - - - - - 26547759 by Matthew Pickering at 2022-04-01T11:07:35+01:00 hadrian: Introduce CheckProgram datatype to replace a 7-tuple - - - - - df65d732 by Jakob Bruenker at 2022-04-01T11:08:28+01:00 Fix panic when pretty printing HsCmdLam When pretty printing a HsCmdLam with more than one argument, GHC panicked because of a missing case. This fixes that. Closes #21300 - - - - - ad6cd165 by John Ericson at 2022-04-01T11:10:06+01:00 hadrian: Remove vestigial -this-unit-id support check This has been dead code since 400ead81e80f66ad7b1260b11b2a92f25ccc3e5a. - - - - - 8ca7ab81 by Matthew Pickering at 2022-04-01T11:10:23+01:00 hadrian: Fix race involving empty package databases There was a small chance of a race occuring between the small window of 1. The first package (.conf) file get written into the database 2. hadrian calling "ghc-pkg recache" to refresh the package.conf file In this window the package database would contain rts.conf but not a package.cache file, and therefore if ghc was invoked it would error because it was missing. To solve this we call "ghc-pkg recache" at when the database is created by shake by writing the stamp file into the database folder. This also creates the package.cache file and so avoids the possibility of this race. - - - - - cc4ec64b by Matthew Pickering at 2022-04-01T11:11:05+01:00 hadrian: Add assertion that in/out tree args are the same There have been a few instances where this calculation was incorrect, so we add a non-terminal assertion when now checks they the two computations indeed compute the same thing. Fixes #21285 - - - - - 691508d8 by Matthew Pickering at 2022-04-01T11:13:10+01:00 hlint: Ignore suggestions in generated HaddockLex file With the make build system this file ends up in the compiler/ subdirectory so is linted. With hadrian, the file ends up in _build so it's not linted. Fixes #21313 - - - - - f8f152e7 by Krzysztof Gogolewski at 2022-04-01T11:14:08+01:00 Change GHC.Prim to GHC.Exts in docs and tests Users are supposed to import GHC.Exts rather than GHC.Prim. Part of #18749. - - - - - f8fc6d2e by Matthew Pickering at 2022-04-01T11:15:24+01:00 driver: Improve -Wunused-packages error message (and simplify implementation) In the past I improved the part of -Wunused-packages which found which packages were used. Now I improve the part which detects which ones were specified. The key innovation is to use the explicitUnits field from UnitState which has the result of resolving the package flags, so we don't need to mess about with the flag arguments from DynFlags anymore. The output now always includes the package name and version (and the flag which exposed it). ``` The following packages were specified via -package or -package-id flags, but were not needed for compilation: - bytestring-0.11.2.0 (exposed by flag -package bytestring) - ghc-9.3 (exposed by flag -package ghc) - process-1.6.13.2 (exposed by flag -package process) ``` Fixes #21307 - - - - - 5e5a12d9 by Matthew Pickering at 2022-04-01T11:15:32+01:00 driver: In oneshot mode, look for interface files in hidir How things should work: * -i is the search path for source files * -hidir explicitly sets the search path for interface files and the output location for interface files. * -odir sets the search path and output location for object files. Before in one shot mode we would look for the interface file in the search locations given by `-i`, but then set the path to be in the `hidir`, so in unusual situations the finder could find an interface file in the `-i` dir but later fail because it tried to read the interface file from the `-hidir`. A bug identified by #20569 - - - - - 950f58e7 by Matthew Pickering at 2022-04-01T11:15:36+01:00 docs: Update documentation interaction of search path, -hidir and -c mode. As noted in #20569 the documentation for search path was wrong because it seemed to indicate that `-i` dirs were important when looking for interface files in `-c` mode, but they are not important if `-hidir` is set. Fixes #20569 - - - - - d85c7dcb by sheaf at 2022-04-01T11:17:56+01:00 Keep track of promotion ticks in HsOpTy This patch adds a PromotionFlag field to HsOpTy, which is used in pretty-printing and when determining whether to emit warnings with -fwarn-unticked-promoted-constructors. This allows us to correctly report tick-related warnings for things like: type A = Int : '[] type B = [Int, Bool] Updates haddock submodule Fixes #19984 - - - - - 32070e6c by Jakob Bruenker at 2022-04-01T20:31:08+02:00 Implement \cases (Proposal 302) This commit implements proposal 302: \cases - Multi-way lambda expressions. This adds a new expression heralded by \cases, which works exactly like \case, but can match multiple apats instead of a single pat. Updates submodule haddock to support the ITlcases token. Closes #20768 - - - - - c6f77f39 by sheaf at 2022-04-01T20:33:05+02:00 Add a regression test for #21323 This bug was fixed at some point between GHC 9.0 and GHC 9.2; this patch simply adds a regression test. - - - - - 3596684e by Jakob Bruenker at 2022-04-01T20:33:05+02:00 Fix error when using empty case in arrow notation It was previously not possible to use -XEmptyCase in Arrow notation, since GHC would print "Exception: foldb of empty list". This is now fixed. Closes #21301 - - - - - 9a325b59 by Ben Gamari at 2022-04-01T20:33:05+02:00 users-guide: Fix various markup issues - - - - - aefb1e6d by sheaf at 2022-04-01T20:36:01+02:00 Ensure implicit parameters are lifted `tcExpr` typechecked implicit parameters by introducing a metavariable of kind `TYPE kappa`, without enforcing that `kappa ~ LiftedRep`. This patch instead creates a metavariable of kind `Type`. Fixes #21327 - - - - - ed62dc66 by Ben Gamari at 2022-04-05T11:44:51-04:00 gitlab-ci: Disable cabal-install store caching on Windows For reasons that remain a mystery, cabal-install seems to consistently corrupt its cache on Windows. Disable caching for now. Works around #21347. - - - - - 5ece5c5a by Ryan Scott at 2022-04-06T13:00:51-04:00 Add /linters/*/dist-install/ to .gitignore Fixes #21335. [ci skip] - - - - - 410c76ee by Ben Gamari at 2022-04-06T13:01:28-04:00 Use static archives as an alternative to object merging Unfortunately, `lld`'s COFF backend does not currently support object merging. With ld.bfd having broken support for high image-load base addresses, it's necessary to find an alternative. Here I introduce support in the driver for generating static archives, which we use on Windows instead of object merging. Closes #21068. - - - - - 400666c8 by Ben Gamari at 2022-04-06T13:01:28-04:00 rts/linker: Catch archives masquerading as object files Check the file's header to catch static archive bearing the `.o` extension, as may happen on Windows after the Clang refactoring. See #21068 - - - - - 694d39f0 by Ben Gamari at 2022-04-06T13:01:28-04:00 driver: Make object merging optional On Windows we don't have a linker which supports object joining (i.e. the `-r` flag). Consequently, `-pgmlm` is now a `Maybe`. See #21068. - - - - - 41fcb5cd by Ben Gamari at 2022-04-06T13:01:28-04:00 hadrian: Refactor handling of ar flags Previously the setup was quite fragile as it had to assume which arguments were file arguments and which were flags. - - - - - 3ac80a86 by Ben Gamari at 2022-04-06T13:01:28-04:00 hadrian: Produce ar archives with L modifier on Windows Since object files may in fact be archive files, we must ensure that their contents are merged rather than constructing an archive-of-an-archive. See #21068. - - - - - 295c35c5 by Ben Gamari at 2022-04-06T13:01:28-04:00 Add a Note describing lack of object merging on Windows See #21068. - - - - - d2ae0a3a by Ben Gamari at 2022-04-06T13:01:28-04:00 Build ar archives with -L when "joining" objects Since there may be .o files which are in fact archives. - - - - - babb47d2 by Zubin Duggal at 2022-04-06T13:02:04-04:00 Add warnings for file header pragmas that appear in the body of a module (#20385) Once we are done parsing the header of a module to obtain the options, we look through the rest of the tokens in order to determine if they contain any misplaced file header pragmas that would usually be ignored, potentially resulting in bad error messages. The warnings are reported immediately so that later errors don't shadow over potentially helpful warnings. Metric Increase: T13719 - - - - - 3f31825b by Ben Gamari at 2022-04-06T13:02:40-04:00 rts/AdjustorPool: Generalize to allow arbitrary contexts Unfortunately the i386 adjustor logic needs this. - - - - - 9b645ee1 by Ben Gamari at 2022-04-06T13:02:40-04:00 adjustors/i386: Use AdjustorPool In !7511 (closed) I introduced a new allocator for adjustors, AdjustorPool, which eliminates the address space fragmentation issues which adjustors can introduce. In that work I focused on amd64 since that was the platform where I observed issues. However, in #21132 we noted that the size of adjustors is also a cause of CI fragility on i386. In this MR I port i386 to use AdjustorPool. Sadly the complexity of the i386 adjustor code does cause require a bit of generalization which makes the code a bit more opaque but such is the world. Closes #21132. - - - - - c657a616 by Ben Gamari at 2022-04-06T13:03:16-04:00 hadrian: Clean up flavour transformer definitions Previously the `ipe` and `omit_pragmas` transformers were hackily defined using the textual key-value syntax. Fix this. - - - - - 9ce273b9 by Ben Gamari at 2022-04-06T13:03:16-04:00 gitlab-ci: Drop dead HACKAGE_INDEX_STATE variable - - - - - 01845375 by Ben Gamari at 2022-04-06T13:03:16-04:00 gitlab/darwin: Factor out bindists This makes it a bit easier to bump them. - - - - - c41c478e by Ben Gamari at 2022-04-06T13:03:16-04:00 Fix a few new warnings when booting with GHC 9.2.2 -Wuni-incomplete-patterns and apparent improvements in the pattern match checker surfaced these. - - - - - 6563cd24 by Ben Gamari at 2022-04-06T13:03:16-04:00 gitlab-ci: Bump bootstrap compiler to 9.2.2 This is necessary to build recent `text` commits. Bumps Hackage index state for a hashable which builds with GHC 9.2. - - - - - a62e983e by Ben Gamari at 2022-04-06T13:03:16-04:00 Bump text submodule to current `master` Addresses #21295. - - - - - 88d61031 by Vladislav Zavialov at 2022-04-06T13:03:53-04:00 Refactor OutputableBndrFlag instances The matching on GhcPass introduced by 95275a5f25a is not necessary. This patch reverts it to make the code simpler. - - - - - f601f002 by GHC GitLab CI at 2022-04-06T15:18:26-04:00 rts: Eliminate use of nested functions This is a gcc-specific extension. - - - - - d4c5f29c by Ben Gamari at 2022-04-06T15:18:26-04:00 driver: Drop hacks surrounding windres invocation Drop hack for #1828, among others as they appear to be unnecessary when using `llvm-windres`. - - - - - 6be2c5a7 by Ben Gamari at 2022-04-06T15:18:26-04:00 Windows/Clang: Build system adaptation * Bump win32-tarballs to 0.7 * Move Windows toolchain autoconf logic into separate file * Use clang and LLVM utilities as described in #21019 * Disable object merging as lld doesn't support -r * Drop --oformat=pe-bigobj-x86-64 arguments from ld flags as LLD detects that the output is large on its own. * Drop gcc wrapper since Clang finds its root fine on its own. - - - - - c6fb7aff by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Test that we can build bigobj PE objects - - - - - 79851c07 by Ben Gamari at 2022-04-06T15:18:26-04:00 Drop -static-libgcc This flag is not applicable when Clang is used. - - - - - 1f8a8264 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Port T16514 to C Previously this test was C++ which made it a bit of a portability problem. - - - - - d7e650d1 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Mark Windows as a libc++ platform - - - - - d7886c46 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Mark T9405 as fixed on Windows I have not seen it fail since moving to clang. Closes #12714. - - - - - 4c3fbb4e by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Mark FloatFnInverses as fixed The new toolchain has fixed it. Closes #15670. - - - - - 402c36ba by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Rework T13606 to avoid gcc dependence Previously we used libgcc_s's import library in T13606. However, now that we ship with clang we no longer have this library. Instead we now use gdi32. - - - - - 9934ad54 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Clean up tests depending on C++ std lib - - - - - 12fcdef2 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Split T13366 into two tests Split up the C and C++ uses since the latter is significantly more platform-dependent. - - - - - 3c08a198 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Fix mk-big-obj I'm a bit unclear on how this previously worked as it attempted to build an executable without defining `main`. - - - - - 7e97cc23 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Provide module definitions in T10955dyn Otherwise the linker will export all symbols, including those provided by the RTS, from the produced shared object. Consequently, attempting to link against multiple objects simultaneously will cause the linker to complain that RTS symbols are multiply defined. Avoid this by limiting the DLL exports with a module definition file. - - - - - 9a248afa by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Mark test-defaulting-plugin as fragile on Windows Currently llvm-ar does not handle long file paths, resulting in occassional failures of these tests and #21293. - - - - - 39371aa4 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite/driver: Treat framework failures of fragile tests as non-fatal Previously we would report framework failures of tests marked as fragile as failures. Now we rather treat them as fragile test failures, which are not fatal to the testsuite run. Noticed while investigating #21293. - - - - - a1e6661d by Ben Gamari at 2022-04-06T15:18:32-04:00 Bump Cabal submodule - Disable support for library-for-ghci on Windows as described in #21068. - Teach Cabal to use `ar -L` when available - - - - - f7b0f63c by Ben Gamari at 2022-04-06T15:18:37-04:00 Bump process submodule Fixes missing TEST_CC_OPTS in testsuite tests. - - - - - 109cee19 by Ben Gamari at 2022-04-06T15:18:37-04:00 hadrian: Disable ghci libraries when object merging is not available - - - - - c22fba5c by Ben Gamari at 2022-04-06T15:18:37-04:00 Bump bytestring submodule - - - - - 6e2744cc by Ben Gamari at 2022-04-06T15:18:37-04:00 Bump text submodule - - - - - 32333747 by Ben Gamari at 2022-04-06T15:18:37-04:00 hadrian: Build wrappers using ghc rather than cc - - - - - 59787ba5 by Ben Gamari at 2022-04-06T15:18:37-04:00 linker/PEi386: More descriptive error message - - - - - 5e3c3c4f by Ben Gamari at 2022-04-06T15:18:37-04:00 testsuite: Mark TH_spliceE5_prof as unbroken on Windows It was previously failing due to #18721 and now passes with the new toolchain. Closes #18721. - - - - - 9eb0a9d9 by GHC GitLab CI at 2022-04-06T15:23:48-04:00 rts/PEi386: Move some debugging output to -DL - - - - - ce874595 by Ben Gamari at 2022-04-06T15:24:01-04:00 nativeGen/x86: Use %rip-relative addressing On Windows with high-entropy ASLR we must use %rip-relative addressing to avoid overflowing the signed 32-bit immediate size of x86-64. Since %rip-relative addressing comes essentially for free and can make linking significantly easier, we use it on all platforms. - - - - - 52deee64 by Ben Gamari at 2022-04-06T15:24:01-04:00 Generate LEA for label expressions - - - - - 105a0056 by Ben Gamari at 2022-04-06T15:24:01-04:00 Refactor is32BitLit to take Platform rather than Bool - - - - - ec4526b5 by Ben Gamari at 2022-04-06T15:24:01-04:00 Don't assume that labels are 32-bit on Windows - - - - - ffdbe457 by Ben Gamari at 2022-04-06T15:24:01-04:00 nativeGen: Note signed-extended nature of MOV - - - - - bfb79697 by Ben Gamari at 2022-04-06T15:30:56-04:00 rts: Move __USE_MINGW_ANSI_STDIO definition to PosixSource.h It's easier to ensure that this is included first than Rts.h - - - - - 5ad143fd by Ben Gamari at 2022-04-06T15:30:56-04:00 rts: Fix various #include issues This fixes various violations of the newly-added RTS includes linter. - - - - - a59a66a8 by Ben Gamari at 2022-04-06T15:30:56-04:00 testsuite: Lint RTS #includes Verifies two important properties of #includes in the RTS: * That system headers don't appear inside of a `<BeginPrivate.h>` block as this can hide system library symbols, resulting in very hard-to-diagnose linker errors * That no headers precede `Rts.h`, ensuring that __USE_MINGW_ANSI_STDIO is set correctly before system headers are included. - - - - - 42bf7528 by GHC GitLab CI at 2022-04-06T16:25:04-04:00 rts/PEi386: Fix memory leak Previously we would leak the section information of the `.bss` section. - - - - - d286a55c by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/linker: Preserve information about symbol types As noted in #20978, the linker would previously handle overflowed relocations by creating a jump island. While this is fine in the case of code symbols, it's very much not okay in the case of data symbols. To fix this we must keep track of whether each symbol is code or data and relocate them appropriately. This patch takes the first step in this direction, adding a symbol type field to the linker's symbol table. It doesn't yet change relocation behavior to take advantage of this knowledge. Fixes #20978. - - - - - e689e9d5 by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/PEi386: Fix relocation overflow behavior This fixes handling of overflowed relocations on PEi386 targets: * Refuse to create jump islands for relocations of data symbols * Correctly handle the `__imp___acrt_iob_func` symbol, which is an new type of symbol: `SYM_TYPE_INDIRECT_DATA` - - - - - 655e7d8f by GHC GitLab CI at 2022-04-06T16:25:25-04:00 rts: Mark anything that might have an info table as data Tables-next-to-code mandates that we treat symbols with info tables like data since we cannot relocate them using a jump island. See #20983. - - - - - 7e8cc293 by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/PEi386: Rework linker This is a significant rework of the PEi386 linker, making the linker compatible with high image base addresses. Specifically, we now use the m32 allocator instead of `HeapAllocate`. In addition I found a number of latent bugs in our handling of import libraries and relocations. I've added quite a few comments describing what I've learned about Windows import libraries while fixing these. Thanks to Tamar Christina (@Phyx) for providing the address space search logic, countless hours of help while debugging, and his boundless Windows knowledge. Co-Authored-By: Tamar Christina <tamar at zhox.com> - - - - - ff625218 by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/PEi386: Move allocateBytes to MMap.c - - - - - f562b5ca by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/PEi386: Avoid accidentally-quadratic allocation cost We now preserve the address that we last mapped, allowing us to resume our search and avoiding quadratic allocation costs. This fixes the runtime of T10296a, which allocates many adjustors. - - - - - 3247b7db by Ben Gamari at 2022-04-06T16:25:25-04:00 Move msvcrt dep out of base - - - - - fa404335 by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/linker: More descriptive debug output - - - - - 140f338f by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/PathUtils: Define pathprintf in terms of snwprintf on Windows swprintf deviates from usual `snprintf` semantics in that it does not guarantee reasonable behavior when the buffer is NULL (that is, returning the number of bytes that would have been emitted). - - - - - eb60565b by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/linker: Report archive member index - - - - - 209fd61b by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/linker: Split up object resolution and initialization Previously the RTS linker would call initializers during the "resolve" phase of linking. However, this is problematic in the case of cyclic dependencies between objects. In particular, consider the case where we have a situation where a static library contains a set of recursive objects: * object A has depends upon symbols in object B * object B has an initializer that depends upon object A * we try to load object A The linker would previously: 1. start resolving object A 2. encounter the reference to object B, loading it resolve object B 3. run object B's initializer 4. the initializer will attempt to call into object A, which hasn't been fully resolved (and therefore protected) Fix this by moving constructor execution to a new linking phase, which follows resolution. Fix #21253. - - - - - 8e8a1021 by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/linker/LoadArchive: Fix leaking file handle Previously `isArchive` could leak a `FILE` handle if the `fread` returned a short read. - - - - - 429ea5d9 by sheaf at 2022-04-07T07:55:52-04:00 Remove Fun pattern from Typeable COMPLETE set GHC merge request !963 improved warnings in the presence of COMPLETE annotations. This allows the removal of the Fun pattern from the complete set. Doing so expectedly causes some redundant pattern match warnings, in particular in GHC.Utils.Binary.Typeable and Data.Binary.Class from the binary library; this commit addresses that. Updates binary submodule Fixes #20230 - - - - - 54b18824 by Alan Zimmerman at 2022-04-07T07:56:28-04:00 EPA: handling of con_bndrs in mkGadtDecl Get rid of unnnecessary case clause that always matched. Closes #20558 - - - - - 9c838429 by Ben Gamari at 2022-04-07T09:38:53-04:00 testsuite: Mark T10420 as broken on Windows Due to #21322. - - - - - 50739d2b by Ben Gamari at 2022-04-07T09:42:42-04:00 rts: Refactor and fix printf attributes on clang Clang on Windows does not understand the `gnu_printf` attribute; use `printf` instead. - - - - - 9eeaeca4 by Ben Gamari at 2022-04-07T09:42:42-04:00 rts: Add missing newline in error message - - - - - fcef9a17 by Ben Gamari at 2022-04-07T09:42:42-04:00 configure: Make environ decl check more robust Some platforms (e.g. Windows/clang64) declare `environ` in `<stdlib.h>`, not `<unistd.h>` - - - - - 8162b4f3 by Ben Gamari at 2022-04-07T09:42:42-04:00 rts: Adjust RTS symbol table on Windows for ucrt - - - - - 633280d7 by Ben Gamari at 2022-04-07T09:43:21-04:00 testsuite: Fix exit code of bounds checking tests on Windows `abort` exits with 255, not 134, on Windows. - - - - - cab4dc01 by Ben Gamari at 2022-04-07T09:43:31-04:00 testsuite: Update expected output from T5435 tests on Windows I'll admit, I don't currently see *why* this output is reordered but it is a fairly benign difference and I'm out of time to investigate. - - - - - edf5134e by Ben Gamari at 2022-04-07T09:43:35-04:00 testsuite: Mark T20918 as broken on Windows Our toolchain on Windows doesn't currently have Windows support. - - - - - d0ddeff3 by Ben Gamari at 2022-04-07T09:43:39-04:00 testsuite: Mark linker unloading tests as broken on Windows Due to #20354. We will need to investigate this prior the release. - - - - - 5a86da2b by Ben Gamari at 2022-04-07T09:43:43-04:00 testsuite: Mark T9405 as broken on Windows Due to #21361. - - - - - 4aa86dcf by Ben Gamari at 2022-04-07T09:44:18-04:00 Merge branches 'wip/windows-high-codegen', 'wip/windows-high-linker', 'wip/windows-clang-2' and 'wip/lint-rts-includes' into wip/windows-clang-join - - - - - 7206f055 by Ben Gamari at 2022-04-07T09:45:07-04:00 rts/CloneStack: Ensure that Rts.h is #included first As is necessary on Windows. - - - - - 9cfcb27b by Ben Gamari at 2022-04-07T09:45:07-04:00 rts: Fallback to ucrtbase not msvcrt Since we have switched to Clang the toolchain now links against ucrt rather than msvcrt. - - - - - d6665d85 by Ben Gamari at 2022-04-07T09:46:25-04:00 Accept spurious perf test shifts on Windows Metric Decrease: T16875 Metric Increase: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 83363c8b by Simon Peyton Jones at 2022-04-07T12:57:21-04:00 Use prepareBinding in tryCastWorkerWrapper As #21144 showed, tryCastWorkerWrapper was calling prepareRhs, and then unconditionally floating the bindings, without the checks of doFloatFromRhs. That led to floating an unlifted binding into a Rec group. This patch refactors prepareBinding to make these checks, and do them uniformly across all calls. A nice improvement. Other changes * Instead of passing around a RecFlag and a TopLevelFlag; and sometimes a (Maybe SimplCont) for join points, define a new Simplifier-specific data type BindContext: data BindContext = BC_Let TopLevelFlag RecFlag | BC_Join SimplCont and use it consistently. * Kill off completeNonRecX by inlining it. It was only called in one place. * Add a wrapper simplImpRules for simplRules. Compile time on T9630 drops by 4.7%; little else changes. Metric Decrease: T9630 - - - - - 02279a9c by Vladislav Zavialov at 2022-04-07T12:57:59-04:00 Rename [] to List (#21294) This patch implements a small part of GHC Proposal #475. The key change is in GHC.Types: - data [] a = [] | a : [a] + data List a = [] | a : List a And the rest of the patch makes sure that List is pretty-printed as [] in various contexts. Updates the haddock submodule. - - - - - 08480d2a by Simon Peyton Jones at 2022-04-07T12:58:36-04:00 Fix the free-var test in validDerivPred The free-var test (now documented as (VD3)) was too narrow, affecting only class predicates. #21302 demonstrated that this wasn't enough! Fixes #21302. Co-authored-by: Ryan Scott <ryan.gl.scott at gmail.com> - - - - - b3d6d23d by Andreas Klebinger at 2022-04-07T12:59:12-04:00 Properly explain where INLINE pragmas can appear. Fixes #20676 - - - - - 23ef62b3 by Ben Gamari at 2022-04-07T14:28:28-04:00 rts: Fix off-by-one in snwprintf usage - - - - - b2dbcc7d by Simon Jakobi at 2022-04-08T03:00:38-04:00 Improve seq[D]VarSet Previously, the use of size[D]VarSet would involve a traversal of the entire underlying IntMap. Since IntMaps are already spine-strict, this is unnecessary. - - - - - 64ac20a7 by sheaf at 2022-04-08T03:01:16-04:00 Add test for #21338 This no-skolem-info bug was fixed by the no-skolem-info patch that will be part of GHC 9.4. This patch adds a regression test for the issue reported in issue #21338. Fixes #21338. - - - - - c32c4db6 by Ben Gamari at 2022-04-08T03:01:53-04:00 rts: Move __USE_MINGW_ANSI_STDIO definition to PosixSource.h It's easier to ensure that this is included first than Rts.h - - - - - 56f85d62 by Ben Gamari at 2022-04-08T03:01:53-04:00 rts: Fix various #include issues This fixes various violations of the newly-added RTS includes linter. - - - - - cb1f31f5 by Ben Gamari at 2022-04-08T03:01:53-04:00 testsuite: Lint RTS #includes Verifies two important properties of #includes in the RTS: * That system headers don't appear inside of a `<BeginPrivate.h>` block as this can hide system library symbols, resulting in very hard-to-diagnose linker errors * That no headers precede `Rts.h`, ensuring that __USE_MINGW_ANSI_STDIO is set correctly before system headers are included. - - - - - c44432db by Krzysztof Gogolewski at 2022-04-08T03:02:29-04:00 Fixes to 9.4 release notes - Mention -Wforall-identifier - Improve description of withDict - Fix formatting - - - - - 777365f1 by sheaf at 2022-04-08T09:43:35-04:00 Correctly report SrcLoc of redundant constraints We were accidentally dropping the source location information in certain circumstances when reporting redundant constraints. This patch makes sure that we set the TcLclEnv correctly before reporting the warning. Fixes #21315 - - - - - af300a43 by Vladislav Zavialov at 2022-04-08T09:44:11-04:00 Reject illegal quote mark in data con declarations (#17865) * Non-fatal (i.e. recoverable) parse error * Checking infix constructors * Extended the regression test - - - - - 56254e6b by Ben Gamari at 2022-04-08T09:59:46-04:00 Merge remote-tracking branch 'origin/master' - - - - - 6e2c3b7c by Matthew Pickering at 2022-04-08T13:55:15-04:00 driver: Introduce HomeModInfoCache abstraction The HomeModInfoCache is a mutable cache which is updated incrementally as the driver completes, this makes it robust to exceptions including (SIGINT) The interface for the cache is described by the `HomeMOdInfoCache` data type: ``` data HomeModInfoCache = HomeModInfoCache { hmi_clearCache :: IO [HomeModInfo] , hmi_addToCache :: HomeModInfo -> IO () } ``` The first operation clears the cache and returns its contents. This is designed so it's harder to end up in situations where the cache is retained throughout the execution of upsweep. The second operation allows a module to be added to the cache. The one slightly nasty part is in `interpretBuildPlan` where we have to be careful to ensure that the cache writes happen: 1. In parralel 2. Before the executation continues after upsweep. This requires some simple, localised MVar wrangling. Fixes #20780 - - - - - 85f4a3c9 by Andreas Klebinger at 2022-04-08T13:55:50-04:00 Add flag -fprof-manual which controls if GHC should honour manual cost centres. This allows disabling of manual control centres in code a user doesn't control like libraries. Fixes #18867 - - - - - 3415981c by Vladislav Zavialov at 2022-04-08T13:56:27-04:00 HsUniToken for :: in GADT constructors (#19623) One more step towards the new design of EPA. Updates the haddock submodule. - - - - - 23f95735 by sheaf at 2022-04-08T13:57:07-04:00 Docs: datacon eta-expansion, rep-poly checks The existing notes weren't very clear on how the eta-expansion of data constructors that occurs in tcInferDataCon/dsConLike interacts with the representation polymorphism invariants. So we explain with a few more details how we ensure that the representation-polymorphic lambdas introduced by tcInferDataCon/dsConLike don't end up causing problems, by checking they are properly instantiated and then relying on the simple optimiser to perform beta reduction. A few additional changes: - ConLikeTc just take type variables instead of binders, as we never actually used the binders. - Removed the FRRApp constructor of FRROrigin; it was no longer used now that we use ExpectedFunTyOrigin. - Adds a bit of documentation to the constructors of ExpectedFunTyOrigin. - - - - - d4480490 by Matthew Pickering at 2022-04-08T13:57:43-04:00 ci: Replace "always" with "on_success" to stop build jobs running before hadrian-ghci has finished See https://docs.gitlab.com/ee/ci/yaml/#when * always means, always run not matter what * on_success means, run if the dependencies have built successfully - - - - - 0736e949 by Vladislav Zavialov at 2022-04-08T13:58:19-04:00 Disallow (->) as a data constructor name (#16999) The code was misusing isLexCon, which was never meant for validation. In fact, its documentation states the following: Use these functions to figure what kind of name a 'FastString' represents; these functions do /not/ check that the identifier is valid. Ha! This sign can't stop me because I can't read. The fix is to use okConOcc instead. The other checks (isTcOcc or isDataOcc) seem superfluous, so I also removed those. - - - - - e58d5eeb by Simon Peyton Jones at 2022-04-08T13:58:55-04:00 Tiny documentation wibble This commit commit 83363c8b04837ee871a304cf85207cf79b299fb0 Author: Simon Peyton Jones <simon.peytonjones at gmail.com> Date: Fri Mar 11 16:55:38 2022 +0000 Use prepareBinding in tryCastWorkerWrapper refactored completeNonRecX away, but left a Note referring to it. This MR fixes that Note. - - - - - 4bb00839 by Matthew Pickering at 2022-04-09T07:40:28-04:00 ci: Fix nightly head.hackage pipelines This also needs a corresponding commit to head.hackage, I also made the job explicitly depend on the fedora33 job so that it isn't blocked by a failing windows job, which causes docs-tarball to fail. - - - - - 3c48e12a by Matthew Pickering at 2022-04-09T07:40:28-04:00 ci: Remove doc-tarball dependency from perf and perf-nofib jobs These don't depend on the contents of the tarball so we can run them straight after the fedora33 job finishes. - - - - - 27362265 by Matthew Pickering at 2022-04-09T07:41:04-04:00 Bump deepseq to 1.4.7.0 Updates deepseq submodule Fixes #20653 - - - - - dcf30da8 by Joachim Breitner at 2022-04-09T13:02:19-04:00 Drop the app invariant previously, GHC had the "let/app-invariant" which said that the RHS of a let or the argument of an application must be of lifted type or ok for speculation. We want this on let to freely float them around, and we wanted that on app to freely convert between the two (e.g. in beta-reduction or inlining). However, the app invariant meant that simple code didn't stay simple and this got in the way of rules matching. By removing the app invariant, this thus fixes #20554. The new invariant is now called "let-can-float invariant", which is hopefully easier to guess its meaning correctly. Dropping the app invariant means that everywhere where we effectively do beta-reduction (in the two simplifiers, but also in `exprIsConApp_maybe` and other innocent looking places) we now have to check if the argument must be evaluated (unlifted and side-effecting), and analyses have to be adjusted to the new semantics of `App`. Also, `LetFloats` in the simplifier can now also carry such non-floating bindings. The fix for DmdAnal, refine by Sebastian, makes functions with unlifted arguments strict in these arguments, which changes some signatures. This causes some extra calls to `exprType` and `exprOkForSpeculation`, so some perf benchmarks regress a bit (while others improve). Metric Decrease: T9020 Metric Increase: LargeRecord T12545 T15164 T16577 T18223 T5642 T9961 Co-authored-by: Sebastian Graf <sebastian.graf at kit.edu> - - - - - 6c6c5379 by Philip Hazelden at 2022-04-09T13:02:59-04:00 Add functions traceWith, traceShowWith, traceEventWith. As discussed at https://github.com/haskell/core-libraries-committee/issues/36 - - - - - 8fafacf7 by Philip Hazelden at 2022-04-09T13:02:59-04:00 Add tests for several trace functions. - - - - - 20bbf3ac by Philip Hazelden at 2022-04-09T13:02:59-04:00 Update changelog. - - - - - 47d18b0b by Andreas Klebinger at 2022-04-09T13:03:35-04:00 Add regression test for #19569 - - - - - 5f8d6e65 by sheaf at 2022-04-09T13:04:14-04:00 Fix missing SymCo in pushCoercionIntoLambda There was a missing SymCo in pushCoercionIntoLambda. Currently this codepath is only used with rewrite rules, so this bug managed to slip by, but trying to use pushCoercionIntoLambda in other contexts revealed the bug. - - - - - 20eca489 by Vladislav Zavialov at 2022-04-09T13:04:50-04:00 Refactor: simplify lexing of the dot Before this patch, the lexer did a truly roundabout thing with the dot: 1. look up the varsym in reservedSymsFM and turn it into ITdot 2. under OverloadedRecordDot, turn it into ITvarsym 3. in varsym_(prefix|suffix|...) turn it into ITvarsym, ITdot, or ITproj, depending on extensions and whitespace Turns out, the last step is sufficient to handle the dot correctly. This patch removes the first two steps. - - - - - 5440f63e by Hécate Moonlight at 2022-04-12T11:11:06-04:00 Document that DuplicateRecordFields doesn't tolerates ambiguous fields Fix #19891 - - - - - 0090ad7b by Sebastian Graf at 2022-04-12T11:11:42-04:00 Eta reduction based on evaluation context (#21261) I completely rewrote our Notes surrounding eta-reduction. The new entry point is `Note [Eta reduction makes sense]`. Then I went on to extend the Simplifier to maintain an evaluation context in the form of a `SubDemand` inside a `SimplCont`. That `SubDemand` is useful for doing eta reduction according to `Note [Eta reduction based on evaluation context]`, which describes how Demand analysis, Simplifier and `tryEtaReduce` interact to facilitate eta reduction in more scenarios. Thus we fix #21261. ghc/alloc perf marginally improves (-0.0%). A medium-sized win is when compiling T3064 (-3%). It seems that haddock improves by 0.6% to 1.0%, too. Metric Decrease: T3064 - - - - - 4d2ee313 by Sebastian Graf at 2022-04-12T17:54:57+02:00 Specialising through specialised method calls (#19644) In #19644, we discovered that the ClassOp/DFun rules from Note [ClassOp/DFun selection] inhibit transitive specialisation in a scenario like ``` class C a where m :: Show b => a -> b -> ...; n :: ... instance C Int where m = ... -- $cm :: Show b => Int -> b -> ... f :: forall a b. (C a, Show b) => ... f $dC $dShow = ... m @a $dC @b $dShow ... main = ... f @Int @Bool ... ``` After we specialise `f` for `Int`, we'll see `m @a $dC @b $dShow` in the body of `$sf`. But before this patch, Specialise doesn't apply the ClassOp/DFun rule to rewrite to a call of the instance method for `C Int`, e.g., `$cm @Bool $dShow`. As a result, Specialise couldn't further specialise `$cm` for `Bool`. There's a better example in `Note [Specialisation modulo dictionary selectors]`. This patch enables proper Specialisation, as follows: 1. In the App case of `specExpr`, try to apply the CalssOp/DictSel rule on the head of the application 2. Attach an unfolding to freshly-bound dictionary ids such as `$dC` and `$dShow` in `bindAuxiliaryDict` NB: Without (2), (1) would be pointless, because `lookupRule` wouldn't be able to look into the RHS of `$dC` to see the DFun. (2) triggered #21332, because the Specialiser floats around dictionaries without accounting for them in the `SpecEnv`'s `InScopeSet`, triggering a panic when rewriting dictionary unfoldings. Fixes #19644 and #21332. - - - - - b06f4f47 by Sebastian Graf at 2022-04-12T17:54:58+02:00 Specialise: Check `typeDeterminesValue` before specialising on an interesting dictionary I extracted the checks from `Note [Type determines value]` into its own function, so that we share the logic properly. Then I made sure that we actually call `typeDeterminesValue` everywhere we check for `interestingDict`. - - - - - a42dbc55 by Matthew Pickering at 2022-04-13T06:24:52-04:00 Refine warning about defining rules in SAFE modules This change makes it clear that it's the definition rather than any usage which is a problem, and that rules defined in other modules will still be used to do rewrites. Fixes #20923 - - - - - df893f66 by Andreas Klebinger at 2022-04-14T08:18:37-04:00 StgLint: Lint constructor applications and strict workers for arity. This will mean T9208 when run with lint will return a lint error instead of resulting in a panic. Fixes #21117 - - - - - 426ec446 by sheaf at 2022-04-14T08:19:16-04:00 Hadrian: use a set to keep track of ways The order in which ways are provided doesn't matter, so we use a data structure with the appropriate semantics to represent ways. Fixes #21378 - - - - - 7c639b9a by Dylan Yudaken at 2022-04-15T13:55:59-04:00 Only enable PROF_SPIN in DEBUG - - - - - 96b9e5ea by Ben Gamari at 2022-04-15T13:56:34-04:00 testsuite: Add test for #21390 - - - - - d8392f6a by Ben Gamari at 2022-04-15T13:56:34-04:00 rts: Ensure that the interpreter doesn't disregard tags Previously the interpreter's handling of `RET_BCO` stack frames would throw away the tag of the returned closure. This resulted in #21390. - - - - - 83c67f76 by Alan Zimmerman at 2022-04-20T11:49:28-04:00 Add -dkeep-comments flag to keep comments in the parser This provides a way to set the Opt_KeepRawTokenStream from the command line, allowing exact print annotation users to see exactly what is produced for a given parsed file, when used in conjunction with -ddump-parsed-ast Discussed in #19706, but this commit does not close the issue. - - - - - a5ea65c9 by Krzysztof Gogolewski at 2022-04-20T11:50:04-04:00 Remove LevityInfo Every Id was storing a boolean whether it could be levity-polymorphic. This information is no longer needed since representation-checking has been moved to the typechecker. - - - - - 49bd7584 by Andreas Klebinger at 2022-04-20T11:50:39-04:00 Fix a shadowing issue in StgUnarise. For I assume performance reasons we don't record no-op replacements during unarise. This lead to problems with code like this: f = \(Eta_B0 :: VoidType) x1 x2 -> ... let foo = \(Eta_B0 :: LiftedType) -> g x y Eta_B0 in ... Here we would record the outer Eta_B0 as void rep, but would not shadow Eta_B0 inside `foo` because this arg is single-rep and so doesn't need to replaced. But this means when looking at occurence sites we would check the env and assume it's void rep based on the entry we made for the (no longer in scope) outer `Eta_B0`. Fixes #21396 and the ticket has a few more details. - - - - - 0c02c919 by Simon Peyton Jones at 2022-04-20T11:51:15-04:00 Fix substitution in bindAuxiliaryDict In GHC.Core.Opt.Specialise.bindAuxiliaryDict we were unnecessarily calling `extendInScope` to bring into scope variables that were /already/ in scope. Worse, GHC.Core.Subst.extendInScope strangely deleted the newly-in-scope variables from the substitution -- and that was fatal in #21391. I removed the redundant calls to extendInScope. More ambitiously, I changed GHC.Core.Subst.extendInScope (and cousins) to stop deleting variables from the substitution. I even changed the names of the function to extendSubstInScope (and cousins) and audited all the calls to check that deleting from the substitution was wrong. In fact there are very few such calls, and they are all about introducing a fresh non-in-scope variable. These are "OutIds"; it is utterly wrong to mess with the "InId" substitution. I have not added a Note, because I'm deleting wrong code, and it'd be distracting to document a bug. - - - - - 0481a6af by Cheng Shao at 2022-04-21T11:06:06+00:00 [ci skip] Drop outdated TODO in RtsAPI.c - - - - - 1e062a8a by Ben Gamari at 2022-04-22T02:12:59-04:00 rts: Introduce ip_STACK_FRAME While debugging it is very useful to be able to determine whether a given info table is a stack frame or not. We have spare bits in the closure flags array anyways, use one for this information. - - - - - 08a6a2ee by Ben Gamari at 2022-04-22T02:12:59-04:00 rts: Mark closureFlags array as const - - - - - 8f9b8282 by Krzysztof Gogolewski at 2022-04-22T02:13:35-04:00 Check for zero-bit types in sizeExpr Fixes #20940 Metric Decrease: T18698a - - - - - fcf22883 by Andreas Klebinger at 2022-04-22T02:14:10-04:00 Include the way string in the file name for dump files. This can be disabled by `-fno-dump-with-ways` if not desired. Finally we will be able to look at both profiled and non-profiled dumps when compiling with dump flags and we compile in both ways. - - - - - 252394ce by Bodigrim at 2022-04-22T02:14:48-04:00 Improve error messages from GHC.IO.Encoding.Failure - - - - - 250f57c1 by Bodigrim at 2022-04-22T02:14:48-04:00 Update test baselines to match new error messages from GHC.IO.Encoding.Failure - - - - - 5ac9b321 by Ben Gamari at 2022-04-22T02:15:25-04:00 get-win32-tarballs: Drop i686 architecture As of #18487 we no longer support 32-bit Windows. Fixes #21372. - - - - - dd5fecb0 by Ben Gamari at 2022-04-22T02:16:00-04:00 hadrian: Don't rely on xxx not being present in installation path Previously Hadrian's installation makefile would assume that the string `xxx` did not appear in the installation path. This would of course break for some users. Fixes #21402. - - - - - 09e98859 by Ben Gamari at 2022-04-22T02:16:35-04:00 testsuite: Ensure that GHC doesn't pick up environment files Here we set GHC_ENVIRONMENT="-" to ensure that GHC invocations of tests don't pick up a user's local package environment. Fixes #21365. Metric Decrease: T10421 T12234 T12425 T13035 T16875 T9198 - - - - - 76bb8cb3 by Ben Gamari at 2022-04-22T02:17:11-04:00 hadrian: Enable -dlint in devel2 flavour Previously only -dcore-lint was enabled. - - - - - f435d55f by Krzysztof Gogolewski at 2022-04-22T08:00:18-04:00 Fixes to rubbish literals * In CoreToStg, the application 'RUBBISH[rep] x' was simplified to 'RUBBISH[rep]'. But it is possible that the result of the function is represented differently than the function. * In Unarise, 'LitRubbish (primRepToType prep)' is incorrect: LitRubbish takes a RuntimeRep such as IntRep, while primRepToType returns a type such as Any @(TYPE IntRep). Use primRepToRuntimeRep instead. This code is never run in the testsuite. * In StgToByteCode, all rubbish literals were assumed to be boxed. This code predates representation-polymorphic RubbishLit and I think it was not updated. I don't have a testcase for any of those issues, but the code looks wrong. - - - - - 93c16b94 by sheaf at 2022-04-22T08:00:57-04:00 Relax "suppressing errors" assert in reportWanteds The assertion in reportWanteds that we aren't suppressing all the Wanted constraints was too strong: it might be the case that we are inside an implication, and have already reported an unsolved Wanted from outside the implication. It is possible that all Wanteds inside the implication have been rewritten by the outer Wanted, so we shouldn't throw an assertion failure in that case. Fixes #21405 - - - - - 78ec692d by Andreas Klebinger at 2022-04-22T08:01:33-04:00 Mention new MutableByteArray# wrapper in base changelog. - - - - - 56d7cb53 by Eric Lindblad at 2022-04-22T14:13:32-04:00 unlist announce - - - - - 1e4dcf23 by sheaf at 2022-04-22T14:14:12-04:00 decideMonoTyVars: account for CoVars in candidates The "candidates" passed to decideMonoTyVars can contain coercion holes. This is because we might well decide to quantify over some unsolved equality constraints, as long as they are not definitely insoluble. In that situation, decideMonoTyVars was passing a set of type variables that was not closed over kinds to closeWrtFunDeps, which was tripping up an assertion failure. Fixes #21404 - - - - - 2c541f99 by Simon Peyton Jones at 2022-04-22T14:14:47-04:00 Improve floated dicts in Specialise Second fix to #21391. It turned out that we missed calling bringFloatedDictsIntoScope when specialising imports, which led to the same bug as before. I refactored to move that call to a single place, in specCalls, so we can't forget it. This meant making `FloatedDictBinds` into its own type, pairing the dictionary bindings themselves with the set of their binders. Nicer this way. - - - - - 0950e2c4 by Ben Gamari at 2022-04-25T10:18:17-04:00 hadrian: Ensure that --extra-lib-dirs are used Previously we only took `extraLibDirs` and friends from the package description, ignoring any contribution from the `LocalBuildInfo`. Fix this. Fixes #20566. - - - - - 53cc93ae by Ben Gamari at 2022-04-25T10:18:17-04:00 hadrian: Drop redundant include directories The package-specific include directories in Settings.Builders.Common.cIncludeDirs are now redundant since they now come from Cabal. Closes #20566. - - - - - b2721819 by Ben Gamari at 2022-04-25T10:18:17-04:00 hadrian: Clean up handling of libffi dependencies - - - - - 18e5103f by Ben Gamari at 2022-04-25T10:18:17-04:00 testsuite: More robust library way detection Previously `test.mk` would try to determine whether the dynamic, profiling, and vanilla library ways are available by searching for `PrimOpWrappers.{,dyn_,p_}hi` in directory reported by `ghc-pkg field ghc-prim library-dirs`. However, this is extremely fragile as there is no guarantee that there is only one library directory. To handle the case of multiple `library-dirs` correct we would have to carry out the delicate task of tokenising the directory list (in shell, no less). Since this isn't a task that I am eager to solve, I have rather moved the detection logic into the testsuite driver and instead perform a test compilation in each of the ways. This should be more robust than the previous approach. I stumbled upon this while fixing #20579. - - - - - 6c7a4913 by Ben Gamari at 2022-04-25T10:18:17-04:00 testsuite: Cabalify ghc-config To ensure that the build benefits from Hadrian's usual logic for building packages, avoiding #21409. Closes #21409. - - - - - 9af091f7 by Ben Gamari at 2022-04-25T10:18:53-04:00 rts: Factor out built-in GC roots - - - - - e7c4719d by Ben Gamari at 2022-04-25T10:18:54-04:00 Ensure that wired-in exception closures aren't GC'd As described in Note [Wired-in exceptions are not CAFfy], a small set of built-in exception closures get special treatment in the code generator, being declared as non-CAFfy despite potentially containing CAF references. The original intent of this treatment for the RTS to then add StablePtrs for each of the closures, ensuring that they are not GC'd. However, this logic was not applied consistently and eventually removed entirely in 951c1fb0. This lead to #21141. Here we fix this bug by reintroducing the StablePtrs and document the status quo. Closes #21141. - - - - - 9587726f by Ben Gamari at 2022-04-25T10:18:54-04:00 testsuite: Add testcase for #21141 - - - - - cb71226f by Ben Gamari at 2022-04-25T10:19:29-04:00 Drop dead code in GHC.Linker.Static.linkBinary' Previously we supported building statically-linked executables using libtool. However, this was dropped in 91262e75dd1d80f8f28a3922934ec7e59290e28c in favor of using ar/ranlib directly. Consequently we can drop this logic. Fixes #18826. - - - - - 9420d26b by Ben Gamari at 2022-04-25T10:19:29-04:00 Drop libtool path from settings file GHC no longers uses libtool for linking and therefore this is no longer necessary. - - - - - 41cf758b by Ben Gamari at 2022-04-25T10:19:29-04:00 Drop remaining vestiges of libtool Drop libtool logic from gen-dll, allowing us to drop the remaining logic from the `configure` script. Strangely, this appears to reliably reduce compiler allocations of T16875 on Windows. Closes #18826. Metric Decrease: T16875 - - - - - e09afbf2 by Ben Gamari at 2022-04-25T10:20:05-04:00 rts: Refactor handling of dead threads' stacks This fixes a bug that @JunmingZhao42 and I noticed while working on her MMTK port. Specifically, in stg_stop_thread we used stg_enter_info as a sentinel at the tail of a stack after a thread has completed. However, stg_enter_info expects to have a two-field payload, which we do not push. Consequently, if the GC ends up somehow the stack it will attempt to interpret data past the end of the stack as the frame's fields, resulting in unsound behavior. To fix this I eliminate this hacky use of `stg_stop_thread` and instead introduce a new stack frame type, `stg_dead_thread_info`. Not only does this eliminate the potential for the previously mentioned memory unsoundness but it also more clearly captures the intended structure of the dead threads' stacks. - - - - - e76705cf by Ben Gamari at 2022-04-25T10:20:05-04:00 rts: Improve documentation of closure types Also drops the unused TREC_COMMITTED transaction state. - - - - - f2c08124 by Bodigrim at 2022-04-25T10:20:44-04:00 Document behaviour of RULES with KnownNat - - - - - 360dc2bc by Li-yao Xia at 2022-04-25T19:13:06+00:00 Fix rendering of liftA haddock - - - - - 16df6058 by Ben Gamari at 2022-04-27T10:02:25-04:00 testsuite: Report minimum and maximum stat changes As suggested in #20733. - - - - - e39cab62 by Fabian Thorand at 2022-04-27T10:03:03-04:00 Defer freeing of mega block groups Solves the quadratic worst case performance of freeing megablocks that was described in issue #19897. During GC runs, we now keep a secondary free list for megablocks that is neither sorted, nor coalesced. That way, free becomes an O(1) operation at the expense of not being able to reuse memory for larger allocations. At the end of a GC run, the secondary free list is sorted and then merged into the actual free list in a single pass. That way, our worst case performance is O(n log(n)) rather than O(n^2). We postulate that temporarily losing coalescense during a single GC run won't have any adverse effects in practice because: - We would need to release enough memory during the GC, and then after that (but within the same GC run) allocate a megablock group of more than one megablock. This seems unlikely, as large objects are not copied during GC, and so we shouldn't need such large allocations during a GC run. - Allocations of megablock groups of more than one megablock are rare. They only happen when a single heap object is large enough to require that amount of space. Any allocation areas that are supposed to hold more than one heap object cannot use megablock groups, because only the first megablock of a megablock group has valid `bdescr`s. Thus, heap object can only start in the first megablock of a group, not in later ones. - - - - - 5de6be0c by Fabian Thorand at 2022-04-27T10:03:03-04:00 Add note about inefficiency in returnMemoryToOS - - - - - 8bef471a by sheaf at 2022-04-27T10:03:43-04:00 Ensure that Any is Boxed in FFI imports/exports We should only accept the type `Any` in foreign import/export declarations when it has type `Type` or `UnliftedType`. This patch adds a kind check, and a special error message triggered by occurrences of `Any` in foreign import/export declarations at other kinds. Fixes #21305 - - - - - ba3d4e1c by Ben Gamari at 2022-04-27T10:04:19-04:00 Basic response file support Here we introduce support into our command-line parsing infrastructure and driver for handling gnu-style response file arguments, typically used to work around platform command-line length limitations. Fixes #16476. - - - - - 3b6061be by Ben Gamari at 2022-04-27T10:04:19-04:00 testsuite: Add test for #16476 - - - - - 75bf1337 by Matthew Pickering at 2022-04-27T10:04:55-04:00 ci: Fix cabal-reinstall job It's quite nice we can do this by mostly deleting code Fixes #21373 - - - - - 2c00d904 by Matthew Pickering at 2022-04-27T10:04:55-04:00 ci: Add test to check that release jobs have profiled libs - - - - - 50d78d3b by Matthew Pickering at 2022-04-27T10:04:55-04:00 ci: Explicitly handle failures in test_hadrian We also disable the stage1 testing which is broken. Related to #21072 - - - - - 2dcdf091 by Matthew Pickering at 2022-04-27T10:04:55-04:00 ci: Fix shell command - - - - - 55c84123 by Matthew Pickering at 2022-04-27T10:04:55-04:00 bootstrap: Add bootstrapping files for ghc-9_2_2 Fixes #21373 - - - - - c7ee0be6 by Matthew Pickering at 2022-04-27T10:04:55-04:00 ci: Add linting job which checks authors are not GHC CI - - - - - 23aad124 by Adam Sandberg Ericsson at 2022-04-27T10:05:31-04:00 rts: state explicitly what evacuate and scavange mean in the copying gc - - - - - 318e0005 by Ben Gamari at 2022-04-27T10:06:07-04:00 rts/eventlog: Don't attempt to flush if there is no writer If the user has not configured a writer then there is nothing to flush. - - - - - ee11d043 by Ben Gamari at 2022-04-27T10:06:07-04:00 Enable eventlog support in all ways by default Here we deprecate the eventlogging RTS ways and instead enable eventlog support in the remaining ways. This simplifies packaging and reduces GHC compilation times (as we can eliminate two whole compilations of the RTS) while simplifying the end-user story. The trade-off is a small increase in binary sizes in the case that the user does not want eventlogging support, but we think that this is a fine trade-off. This also revealed a latent RTS bug: some files which included `Cmm.h` also assumed that it defined various macros which were in fact defined by `Config.h`, which `Cmm.h` did not include. Fixing this in turn revealed that `StgMiscClosures.cmm` failed to import various spinlock statistics counters, as evidenced by the failed unregisterised build. Closes #18948. - - - - - a2e5ab70 by Andreas Klebinger at 2022-04-27T10:06:43-04:00 Change `-dsuppress-ticks` to only suppress non-code ticks. This means cost centres and coverage ticks will still be present in output. Makes using -dsuppress-all more convenient when looking at profiled builds. - - - - - ec9d7e04 by Ben Gamari at 2022-04-27T10:07:21-04:00 Bump text submodule. This should fix #21352 - - - - - c3105be4 by Bodigrim at 2022-04-27T10:08:01-04:00 Documentation for setLocaleEncoding - - - - - 7f618fd3 by sheaf at 2022-04-27T10:08:40-04:00 Update docs for change to type-checking plugins There was no mention of the changes to type-checking plugins in the 9.4.1 notes, and the extending_ghc documentation contained a reference to an outdated type. - - - - - 4419dd3a by Adam Sandberg Ericsson at 2022-04-27T10:09:18-04:00 rts: add some more documentation to StgWeak closure type - - - - - 5a7f0dee by Matthew Pickering at 2022-04-27T10:09:54-04:00 Give Cmm files fake ModuleNames which include full filepath This fixes the initialisation functions when using -prof or -finfo-table-map. Fixes #21370 - - - - - 81cf52bb by sheaf at 2022-04-27T10:10:33-04:00 Mark GHC.Prim.PtrEq as Unsafe This module exports unsafe pointer equality operations, so we accordingly mark it as Unsafe. Fixes #21433 - - - - - f6a8185d by Ben Gamari at 2022-04-28T09:10:31+00:00 testsuite: Add performance test for #14766 This distills the essence of the Sigs.hs program found in the ticket. - - - - - c7a3dc29 by Douglas Wilson at 2022-04-28T18:54:44-04:00 hadrian: Add Monoid instance to Way - - - - - 654bafea by Douglas Wilson at 2022-04-28T18:54:44-04:00 hadrian: Enrich flavours to build profiled/debugged/threaded ghcs per stage - - - - - 4ad559c8 by Douglas Wilson at 2022-04-28T18:54:44-04:00 hadrian: add debug_ghc and debug_stage1_ghc flavour transformers - - - - - f9728fdb by Douglas Wilson at 2022-04-28T18:54:44-04:00 hadrian: Don't pass -rtsopts when building libraries - - - - - 769279e6 by Matthew Pickering at 2022-04-28T18:54:44-04:00 testsuite: Fix calculation about whether to pass -dynamic to compiler - - - - - da8ae7f2 by Ben Gamari at 2022-04-28T18:55:20-04:00 hadrian: Clean up flavour transformer definitions Previously the `ipe` and `omit_pragmas` transformers were hackily defined using the textual key-value syntax. Fix this. - - - - - 61305184 by Ben Gamari at 2022-04-28T18:55:56-04:00 Bump process submodule - - - - - a8c99391 by sheaf at 2022-04-28T18:56:37-04:00 Fix unification of ConcreteTvs, removing IsRefl# This patch fixes the unification of concrete type variables. The subtlety was that unifying concrete metavariables is more subtle than other metavariables, as decomposition is possible. See the Note [Unifying concrete metavariables], which explains how we unify a concrete type variable with a type 'ty' by concretising 'ty', using the function 'GHC.Tc.Utils.Concrete.concretise'. This can be used to perform an eager syntactic check for concreteness, allowing us to remove the IsRefl# special predicate. Instead of emitting two constraints `rr ~# concrete_tv` and `IsRefl# rr concrete_tv`, we instead concretise 'rr'. If this succeeds we can fill 'concrete_tv', and otherwise we directly emit an error message to the typechecker environment instead of deferring. We still need the error message to be passed on (instead of directly thrown), as we might benefit from further unification in which case we will need to zonk the stored types. To achieve this, we change the 'wc_holes' field of 'WantedConstraints' to 'wc_errors', which stores general delayed errors. For the moement, a delayed error is either a hole, or a syntactic equality error. hasFixedRuntimeRep_MustBeRefl is now hasFixedRuntimeRep_syntactic, and hasFixedRuntimeRep has been refactored to directly return the most useful coercion for PHASE 2 of FixedRuntimeRep. This patch also adds a field ir_frr to the InferResult datatype, holding a value of type Maybe FRROrigin. When this value is not Nothing, this means that we must fill the ir_ref field with a type which has a fixed RuntimeRep. When it comes time to fill such an ExpType, we ensure that the type has a fixed RuntimeRep by performing a representation-polymorphism check with the given FRROrigin This is similar to what we already do to ensure we fill an Infer ExpType with a type of the correct TcLevel. This allows us to properly perform representation-polymorphism checks on 'Infer' 'ExpTypes'. The fillInferResult function had to be moved to GHC.Tc.Utils.Unify to avoid a cyclic import now that it calls hasFixedRuntimeRep. This patch also changes the code in matchExpectedFunTys to make use of the coercions, which is now possible thanks to the previous change. This implements PHASE 2 of FixedRuntimeRep in some situations. For example, the test cases T13105 and T17536b are now both accepted. Fixes #21239 and #21325 ------------------------- Metric Decrease: T18223 T5631 ------------------------- - - - - - 43bd897d by Simon Peyton Jones at 2022-04-28T18:57:13-04:00 Add INLINE pragmas for Enum helper methods As #21343 showed, we need to be super-certain that the "helper methods" for Enum instances are actually inlined or specialised. I also tripped over this when I discovered that numericEnumFromTo and friends had no pragmas at all, so their performance was very fragile. If they weren't inlined, all bets were off. So I've added INLINE pragmas for them too. See new Note [Inline Enum method helpers] in GHC.Enum. I also expanded Note [Checking for INLINE loop breakers] in GHC.Core.Lint to explain why an INLINE function might temporarily be a loop breaker -- this was the initial bug report in #21343. Strangely we get a 16% runtime allocation decrease in perf/should_run/T15185, but only on i386. Since it moves in the right direction I'm disinclined to investigate, so I'll accept it. Metric Decrease: T15185 - - - - - ca1434e3 by Ben Gamari at 2022-04-28T18:57:49-04:00 configure: Bump GHC version to 9.5 Bumps haddock submodule. - - - - - 292e3971 by Teo Camarasu at 2022-04-28T18:58:28-04:00 add since annotation for GHC.Stack.CCS.whereFrom - - - - - 905206d6 by Tamar Christina at 2022-04-28T22:19:34-04:00 winio: add support to iserv. - - - - - d182897e by Tamar Christina at 2022-04-28T22:19:34-04:00 Remove unused line - - - - - 22cf4698 by Matthew Pickering at 2022-04-28T22:20:10-04:00 Revert "rts: Refactor handling of dead threads' stacks" This reverts commit e09afbf2a998beea7783e3de5dce5dd3c6ff23db. - - - - - 8ed57135 by Matthew Pickering at 2022-04-29T04:11:29-04:00 Provide efficient unionMG function for combining two module graphs. This function is used by API clients (hls). This supercedes !6922 - - - - - 0235ff02 by Ben Gamari at 2022-04-29T04:12:05-04:00 Bump bytestring submodule Update to current `master`. - - - - - 01988418 by Matthew Pickering at 2022-04-29T04:12:05-04:00 testsuite: Normalise package versions in UnusedPackages test - - - - - 724d0dc0 by Matthew Pickering at 2022-04-29T08:59:42+00:00 testsuite: Deduplicate ways correctly This was leading to a bug where we would run a profasm test twice which led to invalid junit.xml which meant the test results database was not being populated for the fedora33-perf job. - - - - - 5630dde6 by Ben Gamari at 2022-04-29T13:06:20-04:00 rts: Refactor handling of dead threads' stacks This fixes a bug that @JunmingZhao42 and I noticed while working on her MMTK port. Specifically, in stg_stop_thread we used stg_enter_info as a sentinel at the tail of a stack after a thread has completed. However, stg_enter_info expects to have a two-field payload, which we do not push. Consequently, if the GC ends up somehow the stack it will attempt to interpret data past the end of the stack as the frame's fields, resulting in unsound behavior. To fix this I eliminate this hacky use of `stg_stop_thread` and instead introduce a new stack frame type, `stg_dead_thread_info`. Not only does this eliminate the potential for the previously mentioned memory unsoundness but it also more clearly captures the intended structure of the dead threads' stacks. - - - - - 0cdef807 by parsonsmatt at 2022-04-30T16:51:12-04:00 Add a note about instance visibility across component boundaries In principle, the *visible* instances are * all instances defined in a prior top-level declaration group (see docs on `newDeclarationGroup`), or * all instances defined in any module transitively imported by the module being compiled However, actually searching all modules transitively below the one being compiled is unreasonably expensive, so `reifyInstances` will report only the instance for modules that GHC has had some cause to visit during this compilation. This is a shortcoming: `reifyInstances` might fail to report instances for a type that is otherwise unusued, or instances defined in a different component. You can work around this shortcoming by explicitly importing the modules whose instances you want to be visible. GHC issue #20529 has some discussion around this. Fixes #20529 - - - - - e2dd884a by Ryan Scott at 2022-04-30T16:51:47-04:00 Make mkFunCo take AnonArgFlags into account Previously, whenever `mkFunCo` would produce reflexive coercions, it would use `mkVisFunTy` to produce the kind of the coercion. However, `mkFunCo` is also used to produce coercions between types of the form `ty1 => ty2` in certain places. This has the unfortunate side effect of causing the type of the coercion to appear as `ty1 -> ty2` in certain error messages, as spotted in #21328. This patch address this by changing replacing the use of `mkVisFunTy` with `mkFunctionType` in `mkFunCo`. `mkFunctionType` checks the kind of `ty1` and makes the function arrow `=>` instead of `->` if `ty1` has kind `Constraint`, so this should always produce the correct `AnonArgFlag`. As a result, this patch fixes part (2) of #21328. This is not the only possible way to fix #21328, as the discussion on that issue lists some possible alternatives. Ultimately, it was concluded that the alternatives would be difficult to maintain, and since we already use `mkFunctionType` in `coercionLKind` and `coercionRKind`, using `mkFunctionType` in `mkFunCo` is consistent with this choice. Moreover, using `mkFunctionType` does not regress the performance of any test case we have in GHC's test suite. - - - - - 170da54f by Ben Gamari at 2022-04-30T16:52:27-04:00 Convert More Diagnostics (#20116) Replaces uses of `TcRnUnknownMessage` with proper diagnostics constructors. - - - - - 39edc7b4 by Marius Ghita at 2022-04-30T16:53:06-04:00 Update user guide example rewrite rules formatting Change the rewrite rule examples to include a space between the composition of `f` and `g` in the map rewrite rule examples. Without this change, if the user has locally enabled the extension OverloadedRecordDot the copied example will result in a compile time error that `g` is not a field of `f`. ``` • Could not deduce (GHC.Records.HasField "g" (a -> b) (a1 -> b)) arising from selecting the field ‘g’ ``` - - - - - 2e951e48 by Adam Sandberg Ericsson at 2022-04-30T16:53:42-04:00 ghc-boot: export typesynonyms from GHC.Utils.Encoding This makes the Haddocks easier to understand. - - - - - d8cbc77e by Adam Sandberg Ericsson at 2022-04-30T16:54:18-04:00 users guide: add categories to some flags - - - - - d0f14fad by Chris Martin at 2022-04-30T16:54:57-04:00 hacking guide: mention the core libraries committee - - - - - 34b28200 by Matthew Pickering at 2022-04-30T16:55:32-04:00 Revert "Make the specialiser handle polymorphic specialisation" This reverts commit ef0135934fe32da5b5bb730dbce74262e23e72e8. See ticket #21229 ------------------------- Metric Decrease: T15164 Metric Increase: T13056 ------------------------- - - - - - ee891c1e by Matthew Pickering at 2022-04-30T16:55:32-04:00 Add test for T21229 - - - - - ab677cc8 by Matthew Pickering at 2022-04-30T16:56:08-04:00 Hadrian: Update README about the flavour/testsuite contract There have been a number of tickets about non-tested flavours not passing the testsuite.. this is expected and now noted in the documentation. You use other flavours to run the testsuite at your own risk. Fixes #21418 - - - - - b57b5b92 by Ben Gamari at 2022-04-30T16:56:44-04:00 rts/m32: Fix assertion failure This fixes an assertion failure in the m32 allocator due to the imprecisely specified preconditions of `m32_allocator_push_filled_list`. Specifically, the caller must ensure that the page type is set to filled prior to calling `m32_allocator_push_filled_list`. While this issue did result in an assertion failure in the debug RTS, the issue is in fact benign. - - - - - a7053a6c by sheaf at 2022-04-30T16:57:23-04:00 Testsuite driver: don't crash on empty metrics The testsuite driver crashed when trying to display minimum/maximum performance changes when there are no metrics (i.e. there is no baseline available). This patch fixes that. - - - - - 636f7c62 by Andreas Klebinger at 2022-05-01T22:21:17-04:00 StgLint: Check that functions are applied to compatible runtime reps We use compatibleRep to compare reps, and avoid checking functions with levity polymorphic types because of #21399. - - - - - 60071076 by Hécate Moonlight at 2022-05-01T22:21:55-04:00 Add documentation to the ByteArray# primetype. close #21417 - - - - - 2b2e3020 by Andreas Klebinger at 2022-05-01T22:22:31-04:00 exprIsDeadEnd: Use isDeadEndAppSig to check if a function appliction is bottoming. We used to check the divergence and that the number of arguments > arity. But arity zero represents unknown arity so this was subtly broken for a long time! We would check if the saturated function diverges, and if we applied >=arity arguments. But for unknown arity functions any number of arguments is >=idArity. This fixes #21440. - - - - - 4eaf0f33 by Eric Lindblad at 2022-05-01T22:23:11-04:00 typos - - - - - fc58df90 by Niklas Hambüchen at 2022-05-02T08:59:27+00:00 libraries/base: docs: Explain relationshipt between `finalizeForeignPtr` and `*Conc*` creation Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/21420 - - - - - 3e400f20 by Krzysztof Gogolewski at 2022-05-02T18:29:23-04:00 Remove obsolete code in CoreToStg Note [Nullary unboxed tuple] was removed in e9e61f18a548b70693f4. This codepath is tested by T15696_3. - - - - - 4a780928 by Krzysztof Gogolewski at 2022-05-02T18:29:24-04:00 Fix several note references - - - - - 15ffe2b0 by Sebastian Graf at 2022-05-03T20:11:51+02:00 Assume at least one evaluation for nested SubDemands (#21081, #21133) See the new `Note [SubDemand denotes at least one evaluation]`. A demand `n :* sd` on a let binder `x=e` now means > "`x` was evaluated `n` times and in any program trace it is evaluated, `e` is > evaluated deeply in sub-demand `sd`." The "any time it is evaluated" premise is what this patch adds. As a result, we get better nested strictness. For example (T21081) ```hs f :: (Bool, Bool) -> (Bool, Bool) f pr = (case pr of (a,b) -> a /= b, True) -- before: <MP(L,L)> -- after: <MP(SL,SL)> g :: Int -> (Bool, Bool) g x = let y = let z = odd x in (z,z) in f y ``` The change in demand signature "before" to "after" allows us to case-bind `z` here. Similarly good things happen for the `sd` in call sub-demands `Cn(sd)`, which allows for more eta-reduction (which is only sound with `-fno-pedantic-bottoms`, albeit). We also fix #21085, a surprising inconsistency with `Poly` to `Call` sub-demand expansion. In an attempt to fix a regression caused by less inlining due to eta-reduction in T15426, I eta-expanded the definition of `elemIndex` and `elemIndices`, thus fixing #21345 on the go. The main point of this patch is that it fixes #21081 and #21133. Annoyingly, I discovered that more precise demand signatures for join points can transform a program into a lazier program if that join point gets floated to the top-level, see #21392. There is no simple fix at the moment, but !5349 might. Thus, we accept a ~5% regression in `MultiLayerModulesTH_OneShot`, where #21392 bites us in `addListToUniqDSet`. T21392 reliably reproduces the issue. Surprisingly, ghc/alloc perf on Windows improves much more than on other jobs, by 0.4% in the geometric mean and by 2% in T16875. Metric Increase: MultiLayerModulesTH_OneShot Metric Decrease: T16875 - - - - - 948c7e40 by Andreas Klebinger at 2022-05-04T09:57:34-04:00 CoreLint - When checking for levity polymorphism look through more ticks. For expressions like `(scc<cc_name> primOp#) arg1` we should also look at arg1 to determine if we call primOp# at a fixed runtime rep. This is what corePrep already does but CoreLint didn't yet. This patch will bring them in sync in this regard. It also uses tickishFloatable in CorePrep instead of CorePrep having it's own slightly differing definition of when a tick is floatable. - - - - - 85bc73bd by Alexis King at 2022-05-04T09:58:14-04:00 genprimopcode: Support Unicode properly - - - - - 063d485e by Alexis King at 2022-05-04T09:58:14-04:00 genprimopcode: Replace LaTeX documentation syntax with Haddock The LaTeX documentation generator does not seem to have been used for quite some time, so the LaTeX-to-Haddock preprocessing step has become a pointless complication that makes documenting the contents of GHC.Prim needlessly difficult. This commit replaces the LaTeX syntax with the Haddock it would have been converted into, anyway, though with an additional distinction: it uses single quotes in places to instruct Haddock to generate hyperlinks to bindings. This improves the quality of the generated output. - - - - - d61f7428 by Ben Gamari at 2022-05-04T09:58:50-04:00 rts/ghc.mk: Only build StgCRunAsm.S when it is needed Previously the make build system unconditionally included StgCRunAsm.S in the link, meaning that the RTS would require an execstack unnecessarily. Fixes #21478. - - - - - 934a90dd by Simon Peyton Jones at 2022-05-04T16:15:34-04:00 Improve error reporting in generated code Our error reporting in generated code (via desugaring before typechecking) only worked when the generated code was just a simple call. This commit makes it work in nested cases. - - - - - 445d3657 by sheaf at 2022-05-04T16:16:12-04:00 Ensure Any is not levity-polymorphic in FFI The previous patch forgot to account for a type such as Any @(TYPE (BoxedRep l)) for a quantified levity variable l. - - - - - ddd2591c by Ben Gamari at 2022-05-04T16:16:48-04:00 Update supported LLVM versions Pull forward minimum version to match 9.2. (cherry picked from commit c26faa54c5fbe902ccb74e79d87e3fa705e270d1) - - - - - f9698d79 by Ben Gamari at 2022-05-04T16:16:48-04:00 testsuite/T7275: Use sed -r Darwin requires the `-r` flag to be compatible with GNU sed. (cherry picked from commit 512338c8feec96c38ef0cf799f3a01b77c967c56) - - - - - 8635323b by Ben Gamari at 2022-05-04T16:16:48-04:00 gitlab-ci: Use ld.lld on ARMv7/Linux Due to #16177. Also cleanup some code style issues. (cherry picked from commit cc1c3861e2372f464bf9e3c9c4d4bd83f275a1a6) - - - - - 4f6370c7 by Ben Gamari at 2022-05-04T16:16:48-04:00 gitlab-ci: Always preserve artifacts, even in failed jobs (cherry picked from commit fd08b0c91ea3cab39184f1b1b1aafcd63ce6973f) - - - - - 6f662754 by Ben Gamari at 2022-05-04T16:16:48-04:00 configure: Make sphinx version check more robust It appears that the version of sphinx shipped on CentOS 7 reports a version string of `Sphinx v1...`. Accept the `v`. (cherry picked from commit a9197a292fd4b13308dc6664c01351c7239357ed) - - - - - 0032dc38 by Ben Gamari at 2022-05-04T16:16:48-04:00 gitlab-ci: Don't run make job in release pipelines (cherry picked from commit 16d6a8ff011f2194485387dcca1c00f8ddcdbdeb) - - - - - 27f9aab3 by Ben Gamari at 2022-05-04T16:16:48-04:00 gitlab/ci: Fix name of bootstrap compiler directory Windows binary distributions built with Hadrian have a target platform suffix in the name of their root directory. Teach `ci.sh` about this fact. (cherry picked from commit df5752f39671f6d04d8cd743003469ae5eb67235) - - - - - b528f0f6 by Krzysztof Gogolewski at 2022-05-05T09:05:43-04:00 Fix several note references, part 2 - - - - - 691aacf6 by Adam Sandberg Ericsson at 2022-05-05T09:06:19-04:00 adjustors: align comment about number of integer like arguments with implementation for Amd4+MinGW implementation - - - - - f050557e by Simon Jakobi at 2022-05-05T12:47:32-04:00 Remove two uses of IntMap.size IntMap.size is O(n). The new code should be slightly more efficient. The transformation of GHC.CmmToAsm.CFG.calcFreqs.nodeCount can be described formally as the transformation: (\sum_{0}^{n-1} \sum_{0}^{k-1} i_nk) + n ==> (\sum_{0}^{n-1} 1 + \sum_{0}^{k-1} i_nk) - - - - - 7da90ae3 by Tom Ellis at 2022-05-05T12:48:09-04:00 Explain that 'fail s' should run in the monad itself - - - - - 610d0283 by Matthew Craven at 2022-05-05T12:48:47-04:00 Add a test for the bracketing in rules for (^) - - - - - 016f9ca6 by Matthew Craven at 2022-05-05T12:48:47-04:00 Fix broken rules for (^) with known small powers - - - - - 9372aaab by Matthew Craven at 2022-05-05T12:48:47-04:00 Give the two T19569 tests different names - - - - - 61901b32 by Andreas Klebinger at 2022-05-05T12:49:23-04:00 SpecConstr: Properly create rules for call patterns representing partial applications The main fix is that in addVoidWorkerArg we now add the argument to the front. This fixes #21448. ------------------------- Metric Decrease: T16875 ------------------------- - - - - - 71278dc7 by Teo Camarasu at 2022-05-05T12:50:03-04:00 add since annotations for instances of ByteArray - - - - - 962ff90b by sheaf at 2022-05-05T12:50:42-04:00 Start 9.6.1-notes Updates the documentation notes to start tracking changes for the 9.6.1 release (instead of 9.4). - - - - - aacb15a3 by Matthew Pickering at 2022-05-05T20:24:01-04:00 ci: Add job to check that jobs.yaml is up-to-date There have been quite a few situations where jobs.yaml has been out of date. It's better to add a CI job which checks that it's right. We don't want to use a staged pipeline because it obfuscates the structure of the pipeline. - - - - - be7102e5 by Ben Gamari at 2022-05-05T20:24:37-04:00 rts: Ensure that XMM registers are preserved on Win64 Previously we only preserved the bottom 64-bits of the callee-saved 128-bit XMM registers, in violation of the Win64 calling convention. Fix this. Fixes #21465. - - - - - 73b22ff1 by Ben Gamari at 2022-05-05T20:24:37-04:00 testsuite: Add test for #21465 - - - - - e2ae9518 by Ziyang Liu at 2022-05-06T19:22:22-04:00 Allow `let` just before pure/return in ApplicativeDo The following is currently rejected: ```haskell -- F is an Applicative but not a Monad x :: F (Int, Int) x = do a <- pure 0 let b = 1 pure (a, b) ``` This has bitten me multiple times. This MR contains a simple fix: only allow a "let only" segment to be merged with the next (and not the previous) segment. As a result, when the last one or more statements before pure/return are `LetStmt`s, there will be one more segment containing only those `LetStmt`s. Note that if the `let` statement mentions a name bound previously, then the program is still rejected, for example ```haskell x = do a <- pure 0 let b = a + 1 pure (a, b) ``` or the example in #18559. To support this would require a more complex approach, but this is IME much less common than the previous case. - - - - - 0415449a by Matthew Pickering at 2022-05-06T19:22:58-04:00 template-haskell: Fix representation of OPAQUE pragmas There is a mis-match between the TH representation of OPAQUE pragmas and GHC's internal representation due to how OPAQUE pragmas disallow phase annotations. It seemed most in keeping to just fix the wired in name issue by adding a special case to the desugaring of INLINE pragmas rather than making TH/GHC agree with how the representation should look. Fixes #21463 - - - - - 4de887e2 by Simon Peyton Jones at 2022-05-06T19:23:34-04:00 Comments only: Note [AppCtxt] - - - - - 6e69964d by Matthew Pickering at 2022-05-06T19:24:10-04:00 Fix name of windows release bindist in doc-tarball job - - - - - ced4689e by Matthew Pickering at 2022-05-06T19:24:46-04:00 ci: Generate source-tarball in release jobs We need to distribute the source tarball so we should generate it in the CI pipeline. - - - - - 3c91de21 by Rob at 2022-05-08T13:40:53+02:00 Change Specialise to use OrdList. Fixes #21362 Metric Decrease: T16875 - - - - - 67072c31 by Simon Jakobi at 2022-05-08T12:23:43-04:00 Tweak GHC.CmmToAsm.CFG.delEdge mapAdjust is more efficient than mapAlter. - - - - - 374554bb by Teo Camarasu at 2022-05-09T16:24:37-04:00 Respect -po when heap profiling (#21446) - - - - - 1ea414b6 by Teo Camarasu at 2022-05-09T16:24:37-04:00 add test case for #21446 - - - - - c7902078 by Jens Petersen at 2022-05-09T16:25:17-04:00 avoid hadrian/bindist/Makefile install_docs error when --docs=none When docs are disabled the bindist does not have docs/ and hence docs-utils/ is not generated. Here we just test that docs-utils exists before attempting to install prologue.txt and gen_contents_index to avoid the error: /usr/bin/install: cannot stat 'docs-utils/prologue.txt': No such file or directory make: *** [Makefile:195: install_docs] Error 1 - - - - - 158bd659 by Hécate Moonlight at 2022-05-09T16:25:56-04:00 Correct base's changelog for 4.16.1.0 This commit reaffects the new Ix instances of the foreign integral types from base 4.17 to 4.16.1.0 closes #21529 - - - - - a4fbb589 by Sylvain Henry at 2022-05-09T16:26:36-04:00 STG: only print cost-center if asked to - - - - - 50347ded by Gergo ERDI at 2022-05-10T11:43:33+00:00 Improve "Glomming" note Add a paragraph that clarifies that `occurAnalysePgm` finding out-of-order references, and thus needing to glom, is not a cause for concern when its root cause is rewrite rules. - - - - - df2e3373 by Eric Lindblad at 2022-05-10T20:45:41-04:00 update INSTALL - - - - - dcac3833 by Matthew Pickering at 2022-05-10T20:46:16-04:00 driver: Make -no-keep-o-files -no-keep-hi-files work in --make mode It seems like it was just an oversight to use the incorrect DynFlags (global rather than local) when implementing these two options. Using the local flags allows users to request these intermediate files get cleaned up, which works fine in --make mode because 1. Interface files are stored in memory 2. Object files are only cleaned at the end of session (after link) Fixes #21349 - - - - - 35da81f8 by Ben Gamari at 2022-05-10T20:46:52-04:00 configure: Check for ffi.h As noted in #21485, we checked for ffi.h yet then failed to throw an error if it is missing. Fixes #21485. - - - - - bdc99cc2 by Simon Peyton Jones at 2022-05-10T20:47:28-04:00 Check for uninferrable variables in tcInferPatSynDecl This fixes #21479 See Note [Unquantified tyvars in a pattern synonym] While doing this, I found that some error messages pointed at the pattern synonym /name/, rather than the /declaration/ so I widened the SrcSpan to encompass the declaration. - - - - - 142a73d9 by Matthew Pickering at 2022-05-10T20:48:04-04:00 hadrian: Fix split-sections transformer The splitSections transformer has been broken since -dynamic-too support was implemented in hadrian. This is because we actually build the dynamic way when building the dynamic way, so the predicate would always fail. The fix is to just always pass `split-sections` even if it doesn't do anything for a particular way. Fixes #21138 - - - - - 699f5935 by Matthew Pickering at 2022-05-10T20:48:04-04:00 packaging: Build perf builds with -split-sections In 8f71d958 the make build system was made to use split-sections on linux systems but it appears this logic never made it to hadrian. There is the split_sections flavour transformer but this doesn't appear to be used for perf builds on linux. Closes #21135 - - - - - 21feece2 by Simon Peyton Jones at 2022-05-10T20:48:39-04:00 Use the wrapper for an unlifted binding We assumed the wrapper for an unlifted binding is the identity, but as #21516 showed, that is no always true. Solution is simple: use it. - - - - - 68d1ea5f by Matthew Pickering at 2022-05-10T20:49:15-04:00 docs: Fix path to GHC API docs in index.html In the make bindists we generate documentation in docs/ghc-<VER> but the hadrian bindists generate docs/ghc/ so the path to the GHC API docs was wrong in the index.html file. Rather than make the hadrian and make bindists the same it was easier to assume that if you're using the mkDocs script that you're using hadrian bindists. Fixes #21509 - - - - - 9d8f44a9 by Matthew Pickering at 2022-05-10T20:49:51-04:00 hadrian: Don't pass -j to haddock This has high potential for oversubcribing as many haddock jobs can be spawned in parralel which will each request the given number of capabilities. Once -jsem is implemented (#19416, !5176) we can expose that haddock via haddock and use that to pass a semaphore. Ticket #21136 - - - - - fec3e7aa by Matthew Pickering at 2022-05-10T20:50:27-04:00 hadrian: Only copy and install libffi headers when using in-tree libffi When passed `--use-system-libffi` then we shouldn't copy and install the headers from the system package. Instead the headers are expected to be available as a runtime dependency on the users system. Fixes #21485 #21487 - - - - - 5b791ed3 by mikael at 2022-05-11T08:22:13-04:00 FIND_LLVM_PROG: Recognize llvm suffix used by FreeBSD, ie llc10. - - - - - 8500206e by ARATA Mizuki at 2022-05-11T08:22:57-04:00 Make floating-point abs IEEE 754 compliant The old code used by via-C backend didn't handle the sign bit of NaN. See #21043. - - - - - 4a4c77ed by Alan Zimmerman at 2022-05-11T08:23:33-04:00 EPA: do statement with leading semicolon has wrong anchor The code do; a <- doAsync; b Generated an incorrect Anchor for the statement list that starts after the first semicolon. This commit fixes it. Closes #20256 - - - - - e3ca8dac by Simon Peyton Jones at 2022-05-11T08:24:08-04:00 Specialiser: saturate DFuns correctly Ticket #21489 showed that the saturation mechanism for DFuns (see Note Specialising DFuns) should use both UnspecType and UnspecArg. We weren't doing that; but this MR fixes that problem. No test case because it's hard to tickle, but it showed up in Gergo's work with GHC-as-a-library. - - - - - fcc7dc4c by Ben Gamari at 2022-05-11T20:05:41-04:00 gitlab-ci: Check for dynamic msys2 dependencies Both #20878 and #21196 were caused by unwanted dynamic dependencies being introduced by boot libraries. Ensure that we catch this in CI by attempting to run GHC in an environment with a minimal PATH. - - - - - 3c998f0d by Matthew Pickering at 2022-05-11T20:06:16-04:00 Add back Debian9 CI jobs 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. Fixes #21469 - - - - - dea9a3d9 by Ben Gamari at 2022-05-11T20:06:51-04:00 rts: Drop setExecutable Since f6e366c058b136f0789a42222b8189510a3693d1 setExecutable has been dead code. Drop it. - - - - - 32cdf62d by Simon Peyton Jones at 2022-05-11T20:07:27-04:00 Add a missing guard in GHC.HsToCore.Utils.is_flat_prod_pat This missing guard gave rise to #21519. - - - - - 2c00a8d0 by Matthew Pickering at 2022-05-11T20:08:02-04:00 Add mention of -hi to RTS --help Fixes #21546 - - - - - a2dcad4e by Andre Marianiello at 2022-05-12T02:15:48+00:00 Decouple dynflags in Cmm parser (related to #17957) - - - - - 3a022baa by Andre Marianiello at 2022-05-12T02:15:48+00:00 Remove Module argument from initCmmParserConfig - - - - - 2fc8d76b by Andre Marianiello at 2022-05-12T02:15:48+00:00 Move CmmParserConfig and PDConfig into GHC.Cmm.Parser.Config - - - - - b8c5ffab by Andre Marianiello at 2022-05-12T18:13:55-04:00 Decouple dynflags in GHC.Core.Opt.Arity (related to #17957) Metric Decrease: T16875 - - - - - 3bf938b6 by sheaf at 2022-05-12T18:14:34-04:00 Update extending_ghc for TcPlugin changes The documentation still mentioned Derived constraints and an outdated datatype TcPluginResult. - - - - - 668a9ef4 by jackohughes at 2022-05-13T12:10:34-04:00 Fix printing of brackets in multiplicities (#20315) Change mulArrow to allow for printing of correct application precedence where necessary and update callers of mulArrow to reflect this. As part of this, move mulArrow from GHC/Utils/Outputtable to GHC/Iface/Type. Fixes #20315 - - - - - 30b8b7f1 by Ben Gamari at 2022-05-13T12:11:09-04:00 rts: Add debug output on ocResolve failure This makes it easier to see how resolution failures nest. - - - - - 53b3fa1c by Ben Gamari at 2022-05-13T12:11:09-04:00 rts/PEi386: Fix handling of weak symbols Previously we would flag the symbol as weak but failed to set its address, which must be computed from an "auxiliary" symbol entry the follows the weak symbol. Fixes #21556. - - - - - 5678f017 by Ben Gamari at 2022-05-13T12:11:09-04:00 testsuite: Add tests for #21556 - - - - - 49af0e52 by Ben Gamari at 2022-05-13T22:23:26-04:00 Re-export augment and build from GHC.List Resolves https://gitlab.haskell.org/ghc/ghc/-/issues/19127 - - - - - aed356e1 by Simon Peyton Jones at 2022-05-13T22:24:02-04:00 Comments only around HsWrapper - - - - - 27b90409 by Ben Gamari at 2022-05-16T08:30:44-04:00 hadrian: Introduce linting flavour transformer (+lint) The linting flavour enables -dlint uniformly across anything build by the stage1 compiler. -dcmm-lint is not currently enabled because it fails on i386 (see #21563) - - - - - 3f316776 by Matthew Pickering at 2022-05-16T08:30:44-04:00 hadrian: Uniformly enable -dlint with enableLinting transformer This fixes some bugs where * -dcore-lint was being passed when building stage1 libraries with the boot compiler * -dcore-lint was not being passed when building executables. Fixes #20135 - - - - - 3d74cfca by Andreas Klebinger at 2022-05-16T08:31:20-04:00 Make closure macros EXTERN_INLINE to make debugging easier Implements #21424. The RTS macros get_itbl and friends are extremely helpful during debugging. However only a select few of those were available in the compiled RTS as actual symbols as the rest were INLINE macros. This commit marks all of them as EXTERN_INLINE. This will still inline them at use sites but allow us to use their compiled counterparts during debugging. This allows us to use things like `p get_fun_itbl(ptr)` in the gdb shell since `get_fun_itbl` will now be available as symbol! - - - - - 93153aab by Matthew Pickering at 2022-05-16T08:31:55-04:00 packaging: Introduce CI job for generating hackage documentation This adds a CI job (hackage-doc-tarball) which generates the necessary tarballs for uploading libraries and documentation to hackage. The release script knows to download this folder and the upload script will also upload the release to hackage as part of the release. The `ghc_upload_libs` script is moved from ghc-utils into .gitlab/ghc_upload_libs There are two modes, preparation and upload. * The `prepare` mode takes a link to a bindist and creates a folder containing the source and doc tarballs ready to upload to hackage. * The `upload` mode takes the folder created by prepare and performs the upload to hackage. Fixes #21493 Related to #21512 - - - - - 65d31d05 by Simon Peyton Jones at 2022-05-16T15:32:50-04:00 Add arity to the INLINE pragmas for pattern synonyms The lack of INLNE arity was exposed by #21531. The fix is simple enough, if a bit clumsy. - - - - - 43c018aa by Krzysztof Gogolewski at 2022-05-16T15:33:25-04:00 Misc cleanup - Remove groupWithName (unused) - Use the RuntimeRepType synonym where possible - Replace getUniqueM + mkSysLocalOrCoVar with mkSysLocalOrCoVarM No functional changes. - - - - - 8dfea078 by Pavol Vargovcik at 2022-05-16T15:34:04-04:00 TcPlugin: access to irreducible givens + fix passed ev_binds_var - - - - - fb579e15 by Ben Gamari at 2022-05-17T00:25:02-04:00 driver: Introduce pgmcxx Here we introduce proper support for compilation of C++ objects. This includes: * logic in `configure` to detect the C++ toolchain and propagating this information into the `settings` file * logic in the driver to use the C++ toolchain when compiling C++ sources - - - - - 43628ed4 by Ben Gamari at 2022-05-17T00:25:02-04:00 testsuite: Build T20918 with HC, not CXX - - - - - 0ef249aa by Ben Gamari at 2022-05-17T00:25:02-04:00 Introduce package to capture dependency on C++ stdlib Here we introduce a new "virtual" package into the initial package database, `system-cxx-std-lib`. This gives users a convenient, platform agnostic way to link against C++ libraries, addressing #20010. Fixes #20010. - - - - - 03efe283 by Ben Gamari at 2022-05-17T00:25:02-04:00 testsuite: Add tests for system-cxx-std-lib package Test that we can successfully link against C++ code both in GHCi and batch compilation. See #20010 - - - - - 5f6527e0 by nineonine at 2022-05-17T00:25:38-04:00 OverloadedRecordFields: mention parent name in 'ambiguous occurrence' error for better disambiguation (#17420) - - - - - eccdb208 by Simon Peyton Jones at 2022-05-17T07:16:39-04:00 Adjust flags for pprTrace We were using defaultSDocContext for pprTrace, which suppresses lots of useful infomation. This small MR adds GHC.Utils.Outputable.traceSDocContext and uses it for pprTrace and pprTraceUserWarning. traceSDocContext is a global, and hence not influenced by flags, but that seems unavoidable. But I made the sdocPprDebug bit controlled by unsafeHasPprDebug, since we have the latter for exactly this purpose. Fixes #21569 - - - - - d2284c4c by Simon Peyton Jones at 2022-05-17T07:17:15-04:00 Fix bad interaction between withDict and the Specialiser This MR fixes a bad bug, where the withDict was inlined too vigorously, which in turn made the type-class Specialiser generate a bogus specialisation, because it saw the same overloaded function applied to two /different/ dictionaries. Solution: inline `withDict` later. See (WD8) of Note [withDict] in GHC.HsToCore.Expr See #21575, which is fixed by this change. - - - - - 70f52443 by Matthew Pickering at 2022-05-17T07:17:50-04:00 Bump time submodule to 1.12.2 This bumps the time submodule to the 1.12.2 release. Fixes #21571 - - - - - 2343457d by Vladislav Zavialov at 2022-05-17T07:18:26-04:00 Remove unused test files (#21582) Those files were moved to the perf/ subtree in 11c9a469, and then accidentally reintroduced in 680ef2c8. - - - - - cb52b4ae by Ben Gamari at 2022-05-17T16:00:14-04:00 CafAnal: Improve code clarity Here we implement a few measures to improve the clarity of the CAF analysis implementation. Specifically: * Use CafInfo instead of Bool since the former is more descriptive * Rename CAFLabel to CAFfyLabel, since not all CAFfyLabels are in fact CAFs * Add numerous comments - - - - - b048a9f4 by Ben Gamari at 2022-05-17T16:00:14-04:00 codeGen: Ensure that static datacon apps are included in SRTs When generating an SRT for a recursive group, GHC.Cmm.Info.Build.oneSRT filters out recursive references, as described in Note [recursive SRTs]. However, doing so for static functions would be unsound, for the reason described in Note [Invalid optimisation: shortcutting]. However, the same argument applies to static data constructor applications, as we discovered in #20959. Fix this by ensuring that static data constructor applications are included in recursive SRTs. The approach here is not entirely satisfactory, but it is a starting point. Fixes #20959. - - - - - 0e2d16eb by Matthew Pickering at 2022-05-17T16:00:50-04:00 Add test for #21558 This is now fixed on master and 9.2 branch. Closes #21558 - - - - - ef3c8d9e by Sylvain Henry at 2022-05-17T20:22:02-04:00 Don't store LlvmConfig into DynFlags LlvmConfig contains information read from llvm-passes and llvm-targets files in GHC's top directory. Reading these files is done only when needed (i.e. when the LLVM backend is used) and cached for the whole compiler session. This patch changes the way this is done: - Split LlvmConfig into LlvmConfig and LlvmConfigCache - Store LlvmConfigCache in HscEnv instead of DynFlags: there is no good reason to store it in DynFlags. As it is fixed per session, we store it in the session state instead (HscEnv). - Initializing LlvmConfigCache required some changes to driver functions such as newHscEnv. I've used the opportunity to untangle initHscEnv from initGhcMonad (in top-level GHC module) and to move it to GHC.Driver.Main, close to newHscEnv. - I've also made `cmmPipeline` independent of HscEnv in order to remove the call to newHscEnv in regalloc_unit_tests. - - - - - 828fbd8a by Andreas Klebinger at 2022-05-17T20:22:38-04:00 Give all EXTERN_INLINE closure macros prototypes - - - - - cfc8e2e2 by Ben Gamari at 2022-05-19T04:57:51-04:00 base: Introduce [sg]etFinalizerExceptionHandler This introduces a global hook which is called when an exception is thrown during finalization. - - - - - 372cf730 by Ben Gamari at 2022-05-19T04:57:51-04:00 base: Throw exceptions raised while closing finalized Handles Fixes #21336. - - - - - 3dd2f944 by Ben Gamari at 2022-05-19T04:57:51-04:00 testsuite: Add tests for #21336 - - - - - 297156e0 by Matthew Pickering at 2022-05-19T04:58:27-04:00 Add release flavour and use it for the release jobs The release flavour is essentially the same as the perf flavour currently but also enables `-haddock`. I have hopefully updated all the relevant places where the `-perf` flavour was hardcoded. Fixes #21486 - - - - - a05b6293 by Matthew Pickering at 2022-05-19T04:58:27-04:00 ci: Don't build sphinx documentation on centos The centos docker image lacks the sphinx builder so we disable building sphinx docs for these jobs. Fixes #21580 - - - - - 209d7c69 by Matthew Pickering at 2022-05-19T04:58:27-04:00 ci: Use correct syntax when args list is empty This seems to fail on the ancient version of bash present on CentOS - - - - - 02d16334 by Matthew Pickering at 2022-05-19T04:59:03-04:00 hadrian: Don't attempt to build dynamic profiling libraries We only support building static profiling libraries, the transformer was requesting things like a dynamic, threaded, debug, profiling RTS, which we have never produced nor distributed. Fixes #21567 - - - - - 35bdab1c by Ben Gamari at 2022-05-19T04:59:39-04:00 configure: Check CC_STAGE0 for --target support We previously only checked the stage 1/2 compiler for --target support. We got away with this for quite a while but it eventually caught up with us in #21579, where `bytestring`'s new NEON implementation was unbuildable on Darwin due to Rosetta's seemingly random logic for determining which executable image to execute. This lead to a confusing failure to build `bytestring`'s cbits, when `clang` tried to compile NEON builtins while targetting x86-64. Fix this by checking CC_STAGE0 for --target support. Fixes #21579. - - - - - 0ccca94b by Norman Ramsey at 2022-05-20T05:32:32-04:00 add dominator analysis of `CmmGraph` This commit adds module `GHC.Cmm.Dominators`, which provides a wrapper around two existing algorithms in GHC: the Lengauer-Tarjan dominator analysis from the X86 back end and the reverse postorder ordering from the Cmm Dataflow framework. Issue #20726 proposes that we evaluate some alternatives for dominator analysis, but for the time being, the best path forward is simply to use the existing analysis on `CmmGraph`s. This commit addresses a bullet in #21200. - - - - - 54f0b578 by Norman Ramsey at 2022-05-20T05:32:32-04:00 add dominator-tree function - - - - - 05ed917b by Norman Ramsey at 2022-05-20T05:32:32-04:00 add HasDebugCallStack; remove unneeded extensions - - - - - 0b848136 by Andreas Klebinger at 2022-05-20T05:32:32-04:00 document fields of `DominatorSet` - - - - - 8a26e8d6 by Ben Gamari at 2022-05-20T05:33:08-04:00 nonmoving: Fix documentation of GC statistics fields These were previously incorrect. Fixes #21553. - - - - - c1e24e61 by Matthew Pickering at 2022-05-20T05:33:44-04:00 Remove pprTrace from pushCoercionIntoLambda (#21555) This firstly caused spurious output to be emitted (as evidenced by #21555) but even worse caused a massive coercion to be attempted to be printed (> 200k terms) which would invariably eats up all the memory of your computer. The good news is that removing this trace allows the program to compile to completion, the bad news is that the program exhibits a core lint error (on 9.0.2) but not any other releases it seems. Fixes #21577 and #21555 - - - - - a36d12ee by Zubin Duggal at 2022-05-20T10:44:35-04:00 docs: Fix LlvmVersion in manpage (#21280) - - - - - 36b8a57c by Matthew Pickering at 2022-05-20T10:45:10-04:00 validate: Use $make rather than make In the validate script we are careful to use the $make variable as this stores whether we are using gmake, make, quiet mode etc. There was just this one place where we failed to use it. Fixes #21598 - - - - - 4aa3c5bd by Norman Ramsey at 2022-05-21T03:11:04+00:00 Change `Backend` type and remove direct dependencies With this change, `Backend` becomes an abstract type (there are no more exposed value constructors). Decisions that were formerly made by asking "is the current back end equal to (or different from) this named value constructor?" are now made by interrogating the back end about its properties, which are functions exported by `GHC.Driver.Backend`. There is a description of how to migrate code using `Backend` in the user guide. Clients using the GHC API can find a backdoor to access the Backend datatype in GHC.Driver.Backend.Internal. Bumps haddock submodule. Fixes #20927 - - - - - ecf5f363 by Julian Ospald at 2022-05-21T12:51:16-04:00 Respect DESTDIR in hadrian bindist Makefile, fixes #19646 - - - - - 7edd991e by Julian Ospald at 2022-05-21T12:51:16-04:00 Test DESTDIR in test_hadrian() - - - - - ea895b94 by Matthew Pickering at 2022-05-22T21:57:47-04:00 Consider the stage of typeable evidence when checking stage restriction We were considering all Typeable evidence to be "BuiltinInstance"s which meant the stage restriction was going unchecked. In-fact, typeable has evidence and so we need to apply the stage restriction. This is complicated by the fact we don't generate typeable evidence and the corresponding DFunIds until after typechecking is concluded so we introcue a new `InstanceWhat` constructor, BuiltinTypeableInstance which records whether the evidence is going to be local or not. Fixes #21547 - - - - - ffbe28e5 by Dominik Peteler at 2022-05-22T21:58:23-04:00 Modularize GHC.Core.Opt.LiberateCase Progress towards #17957 - - - - - bc723ac2 by Simon Peyton Jones at 2022-05-23T17:09:34+01:00 Improve FloatOut and SpecConstr This patch addresses a relatively obscure situation that arose when chasing perf regressions in !7847, which itself is fixing It does two things: * SpecConstr can specialise on ($df d1 d2) dictionary arguments * FloatOut no longer checks argument strictness See Note [Specialising on dictionaries] in GHC.Core.Opt.SpecConstr. A test case is difficult to construct, but it makes a big difference in nofib/real/eff/VSM, at least when we have the patch for #21286 installed. (The latter stops worker/wrapper for dictionary arguments). There is a spectacular, but slightly illusory, improvement in runtime perf on T15426. I have documented the specifics in T15426 itself. Metric Decrease: T15426 - - - - - 1a4195b0 by John Ericson at 2022-05-23T17:33:59-04:00 Make debug a `Bool` not an `Int` in `StgToCmmConfig` We don't need any more resolution than this. Rename the field to `stgToCmmEmitDebugInfo` to indicate it is no longer conveying any "level" information. - - - - - e9fff12b by Alan Zimmerman at 2022-05-23T21:04:49-04:00 EPA : Remove duplicate comments in DataFamInstD The code data instance Method PGMigration = MigrationQuery Query -- ^ Run a query against the database | MigrationCode (Connection -> IO (Either String ())) -- ^ Run any arbitrary IO code Resulted in two instances of the "-- ^ Run a query against the database" comment appearing in the Exact Print Annotations when it was parsed. Ensure only one is kept. Closes #20239 - - - - - e2520df3 by Alan Zimmerman at 2022-05-23T21:05:27-04:00 EPA: Comment Order Reversed Make sure comments captured in the exact print annotations are in order of increasing location Closes #20718 - - - - - 4b45fd72 by Teo Camarasu at 2022-05-24T10:49:13-04:00 Add test for T21455 - - - - - e2cd1d43 by Teo Camarasu at 2022-05-24T10:49:13-04:00 Allow passing -po outside profiling way Resolves #21455 - - - - - 3b8c413a by Greg Steuck at 2022-05-24T10:49:52-04:00 Fix haddock_*_perf tests on non-GNU-grep systems Using regexp pattern requires `egrep` and straight up `+`. The haddock_parser_perf and haddock_renamer_perf tests now pass on OpenBSD. They previously incorrectly parsed the files and awk complained about invalid syntax. - - - - - 1db877a3 by Ben Gamari at 2022-05-24T10:50:28-04:00 hadrian/bindist: Drop redundant include of install.mk `install.mk` is already included by `config.mk`. Moreover, `install.mk` depends upon `config.mk` to set `RelocatableBuild`, making this first include incorrect. - - - - - f485d267 by Greg Steuck at 2022-05-24T10:51:08-04:00 Remove -z wxneeded for OpenBSD With all the recent W^X fixes in the loader this workaround is not necessary any longer. I verified that the only tests failing for me on OpenBSD 7.1-current are the same (libc++ related) before and after this commit (with --fast). - - - - - 7c51177d by Andreas Klebinger at 2022-05-24T22:13:19-04:00 Use UnionListsOrd instead of UnionLists in most places. This should get rid of most, if not all "Overlong lists" errors and fix #20016 - - - - - 81b3741f by Andreas Klebinger at 2022-05-24T22:13:55-04:00 Fix #21563 by using Word64 for 64bit shift code. We use the 64bit shifts only on 64bit platforms. But we compile the code always so compiling it on 32bit caused a lint error. So use Word64 instead. - - - - - 2c25fff6 by Zubin Duggal at 2022-05-24T22:14:30-04:00 Fix compilation with -haddock on GHC <= 8.10 -haddock on GHC < 9.0 is quite fragile and can result in obtuse parse errors when it encounters invalid haddock syntax. This has started to affect users since 297156e0b8053a28a860e7a18e1816207a59547b enabled -haddock by default on many flavours. Furthermore, since we don't test bootstrapping with 8.10 on CI, this problem managed to slip throught the cracks. - - - - - cfb9faff by sheaf at 2022-05-24T22:15:12-04:00 Hadrian: don't add "lib" for relocatable builds The conditional in hadrian/bindist/Makefile depended on the target OS, but it makes more sense to use whether we are using a relocatable build. (Currently this only gets set to true on Windows, but this ensures that the logic stays correctly coupled.) - - - - - 9973c016 by Andre Marianiello at 2022-05-25T01:36:09-04:00 Remove HscEnv from GHC.HsToCore.Usage (related to #17957) Metric Decrease: T16875 - - - - - 2ff18e39 by sheaf at 2022-05-25T01:36:48-04:00 SimpleOpt: beta-reduce through casts The simple optimiser would sometimes fail to beta-reduce a lambda when there were casts in between the lambda and its arguments. This can cause problems because we rely on representation-polymorphic lambdas getting beta-reduced away (for example, those that arise from newtype constructors with representation-polymorphic arguments, with UnliftedNewtypes). - - - - - e74fc066 by CarrieMY at 2022-05-25T16:43:03+02:00 Desugar RecordUpd in `tcExpr` This patch typechecks record updates by desugaring them inside the typechecker using the HsExpansion mechanism, and then typechecking this desugared result. Example: data T p q = T1 { x :: Int, y :: Bool, z :: Char } | T2 { v :: Char } | T3 { x :: Int } | T4 { p :: Float, y :: Bool, x :: Int } | T5 The record update `e { x=e1, y=e2 }` desugars as follows e { x=e1, y=e2 } ===> let { x' = e1; y' = e2 } in case e of T1 _ _ z -> T1 x' y' z T4 p _ _ -> T4 p y' x' The desugared expression is put into an HsExpansion, and we typecheck that. The full details are given in Note [Record Updates] in GHC.Tc.Gen.Expr. Fixes #2595 #3632 #10808 #10856 #16501 #18311 #18802 #21158 #21289 Updates haddock submodule - - - - - 2b8bdab8 by Eric Lindblad at 2022-05-26T03:21:58-04:00 update README - - - - - 3d7e7e84 by BinderDavid at 2022-05-26T03:22:38-04:00 Replace dead link in Haddock documentation of Control.Monad.Fail (fixes #21602) - - - - - ee61c7f9 by John Ericson at 2022-05-26T03:23:13-04:00 Add Haddocks for `WwOpts` - - - - - da5ccf0e by Dominik Peteler at 2022-05-26T03:23:13-04:00 Avoid global compiler state for `GHC.Core.Opt.WorkWrap` Progress towards #17957 - - - - - 3bd975b4 by sheaf at 2022-05-26T03:23:52-04:00 Optimiser: avoid introducing bad rep-poly The functions `pushCoValArg` and `pushCoercionIntoLambda` could introduce bad representation-polymorphism. Example: type RR :: RuntimeRep type family RR where { RR = IntRep } type F :: TYPE RR type family F where { F = Int# } co = GRefl F (TYPE RR[0]) :: (F :: TYPE RR) ~# (F |> TYPE RR[0] :: TYPE IntRep) f :: F -> () `pushCoValArg` would transform the unproblematic application (f |> (co -> <()>)) (arg :: F |> TYPE RR[0]) into an application in which the argument does not have a fixed `RuntimeRep`: f ((arg |> sym co) :: (F :: TYPE RR)) - - - - - b22979fb by Fraser Tweedale at 2022-05-26T06:14:51-04:00 executablePath test: fix file extension treatment The executablePath test strips the file extension (if any) when comparing the query result with the expected value. This is to handle platforms where GHC adds a file extension to the output program file (e.g. .exe on Windows). After the initial check, the file gets deleted (if supported). However, it tries to delete the *stripped* filename, which is incorrect. The test currently passes only because Windows does not allow deleting the program while any process created from it is alive. Make the test program correct in general by deleting the *non-stripped* executable filename. - - - - - afde4276 by Fraser Tweedale at 2022-05-26T06:14:51-04:00 fix executablePath test for NetBSD executablePath support for NetBSD was added in a172be07e3dce758a2325104a3a37fc8b1d20c9c, but the test was not updated. Update the test so that it works for NetBSD. This requires handling some quirks: - The result of getExecutablePath could include "./" segments. Therefore use System.FilePath.equalFilePath to compare paths. - The sysctl(2) call returns the original executable name even after it was deleted. Add `canQueryAfterDelete :: [FilePath]` and adjust expectations for the post-delete query accordingly. Also add a note to the `executablePath` haddock to advise that NetBSD behaves differently from other OSes when the file has been deleted. Also accept a decrease in memory usage for T16875. On Windows, the metric is -2.2% of baseline, just outside the allowed ±2%. I don't see how this commit could have influenced this metric, so I suppose it's something in the CI environment. Metric Decrease: T16875 - - - - - d0e4355a by John Ericson at 2022-05-26T06:15:30-04:00 Factor out `initArityOps` to `GHC.Driver.Config.*` module We want `DynFlags` only mentioned in `GHC.Driver`. - - - - - 44bb7111 by romes at 2022-05-26T16:27:57+00:00 TTG: Move MatchGroup Origin field and MatchGroupTc to GHC.Hs - - - - - 88e58600 by sheaf at 2022-05-26T17:38:43-04:00 Add tests for eta-expansion of data constructors This patch adds several tests relating to the eta-expansion of data constructors, including UnliftedNewtypes and DataTypeContexts. - - - - - d87530bb by Richard Eisenberg at 2022-05-26T23:20:14-04:00 Generalize breakTyVarCycle to work with TyFamLHS The function breakTyVarCycle_maybe has been installed in a dark corner of GHC to catch some gremlins (a.k.a. occurs-check failures) who lurk there. But it previously only caught gremlins of the form (a ~ ... F a ...), where some of our intrepid users have spawned gremlins of the form (G a ~ ... F (G a) ...). This commit improves breakTyVarCycle_maybe (and renames it to breakTyEqCycle_maybe) to catch the new gremlins. Happily, the change is remarkably small. The gory details are in Note [Type equality cycles]. Test cases: typecheck/should_compile/{T21515,T21473}. - - - - - ed37027f by Hécate Moonlight at 2022-05-26T23:20:52-04:00 [base] Fix the links in the Data.Data module fix #21658 fix #21657 fix #21657 - - - - - 3bd7d5d6 by Krzysztof Gogolewski at 2022-05-27T16:44:48+02:00 Use a class to check validity of withDict This moves handling of the magic 'withDict' function from the desugarer to the typechecker. Details in Note [withDict]. I've extracted a part of T16646Fail to a separate file T16646Fail2, because the new error in 'reify' hides the errors from 'f' and 'g'. WithDict now works with casts, this fixes #21328. Part of #19915 - - - - - b54f6c4f by sheaf at 2022-05-28T21:00:09-04:00 Fix FreeVars computation for mdo Commit acb188e0 introduced a regression in the computation of free variables in mdo statements, as the logic in GHC.Rename.Expr.segmentRecStmts was slightly different depending on whether the recursive do block corresponded to an mdo statement or a rec statment. This patch restores the previous computation for mdo blocks. Fixes #21654 - - - - - 0704295c by Matthew Pickering at 2022-05-28T21:00:45-04:00 T16875: Stabilise (temporarily) by increasing acceptance threshold The theory is that on windows there is some difference in the environment between pipelines on master and merge requests which affects all tests equally but because T16875 barely allocates anything it is the test which is affected the most. See #21557 - - - - - 6341c8ed by Matthew Pickering at 2022-05-28T21:01:20-04:00 make: Fix make maintainer-clean deleting a file tracked by source control Fixes #21659 - - - - - fbf2f254 by Bodigrim at 2022-05-28T21:01:58-04:00 Expand documentation of hIsTerminalDevice - - - - - 0092c67c by Teo Camarasu at 2022-05-29T12:25:39+00:00 export IsList from GHC.IsList it is still re-exported from GHC.Exts - - - - - 91396327 by Sylvain Henry at 2022-05-30T09:40:55-04:00 MachO linker: fix handling of ARM64_RELOC_SUBTRACTOR ARM64_RELOC_SUBTRACTOR relocations are paired with an AMR64_RELOC_UNSIGNED relocation to implement: addend + sym1 - sym2 The linker was doing it in two steps, basically: *addend <- *addend - sym2 *addend <- *addend + sym1 The first operation was likely to overflow. For example when the relocation target was 32-bit and both sym1/sym2 were 64-bit addresses. With the small memory model, (sym1-sym2) would fit in 32 bits but (*addend-sym2) may not. Now the linker does it in one step: *addend <- *addend + sym1 - sym2 - - - - - acc26806 by Sylvain Henry at 2022-05-30T09:40:55-04:00 Some fixes to SRT documentation - reordered the 3 SRT implementation cases from the most general to the most specific one: USE_SRT_POINTER -> USE_SRT_OFFSET -> USE_INLINE_SRT_FIELD - added requirements for each - found and documented a confusion about "SRT inlining" not supported with MachO. (It is fixed in the following commit) - - - - - 5878f439 by Sylvain Henry at 2022-05-30T09:40:55-04:00 Enable USE_INLINE_SRT_FIELD on ARM64 It was previously disabled because of: - a confusion about "SRT inlining" (see removed comment in this commit) - a linker bug (overflow) in the handling of ARM64_RELOC_SUBTRACTOR relocation: fixed by a previous commit. - - - - - 59bd6159 by Matthew Pickering at 2022-05-30T09:41:39-04:00 ci: Make sure to exit promptly if `make install` fails. Due to the vageries of bash, you have to explicitly handle the failure and exit when in a function. This failed to exit promptly when !8247 was failing. See #21358 for the general issue - - - - - 5a5a28da by Sylvain Henry at 2022-05-30T09:42:23-04:00 Split GHC.HsToCore.Foreign.Decl This is preliminary work for JavaScript support. It's better to put the code handling the desugaring of Prim, C and JavaScript declarations into separate modules. - - - - - 6f5ff4fa by Sylvain Henry at 2022-05-30T09:43:05-04:00 Bump hadrian to LTS-19.8 (GHC 9.0.2) - - - - - f2e70707 by Sylvain Henry at 2022-05-30T09:43:05-04:00 Hadrian: remove unused code - - - - - 2f215b9f by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Eta reduction with casted function We want to be able to eta-reduce \x y. ((f x) |> co) y by pushing 'co' inwards. A very small change accommodates this See Note [Eta reduction with casted function] - - - - - f4f6a87a by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Do arity trimming at bindings, rather than in exprArity Sometimes there are very large casts, and coercionRKind can be slow. - - - - - 610a2b83 by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Make findRhsArity take RecFlag This avoids a fixpoint iteration for the common case of non-recursive bindings. - - - - - 80ba50c7 by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Comments and white space - - - - - 0079171b by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Make PrimOpId record levity This patch concerns #20155, part (1) The general idea is that since primops have curried bindings (currently in PrimOpWrappers.hs) we don't need to eta-expand them. But we /do/ need to eta-expand the levity-polymorphic ones, because they /don't/ have bindings. This patch makes a start in that direction, by identifying the levity-polymophic primops in the PrimOpId IdDetails constructor. For the moment, I'm still eta-expanding all primops (by saying that hasNoBinding returns True for all primops), because of the bug reported in #20155. But I hope that before long we can tidy that up too, and remove the TEMPORARILY stuff in hasNoBinding. - - - - - 6656f016 by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: * Move state-hack stuff from GHC.Types.Id (where it never belonged) to GHC.Core.Opt.Arity (which seems much more appropriate). * Add a crucial mkCast in the Cast case of GHC.Core.Opt.Arity.eta_expand; helps with T18223 * Add clarifying notes about eta-reducing to PAPs. See Note [Do not eta reduce PAPs] * I moved tryEtaReduce from GHC.Core.Utils to GHC.Core.Opt.Arity, where it properly belongs. See Note [Eta reduce PAPs] * In GHC.Core.Opt.Simplify.Utils.tryEtaExpandRhs, pull out the code for when eta-expansion is wanted, to make wantEtaExpansion, and all that same function in GHC.Core.Opt.Simplify.simplStableUnfolding. It was previously inconsistent, but it's doing the same thing. * I did a substantial refactor of ArityType; see Note [ArityType]. This allowed me to do away with the somewhat mysterious takeOneShots; more generally it allows arityType to describe the function, leaving its clients to decide how to use that information. I made ArityType abstract, so that clients have to use functions to access it. * Make GHC.Core.Opt.Simplify.Utils.rebuildLam (was stupidly called mkLam before) aware of the floats that the simplifier builds up, so that it can still do eta-reduction even if there are some floats. (Previously that would not happen.) That means passing the floats to rebuildLam, and an extra check when eta-reducting (etaFloatOk). * In GHC.Core.Opt.Simplify.Utils.tryEtaExpandRhs, make use of call-info in the idDemandInfo of the binder, as well as the CallArity info. The occurrence analyser did this but we were failing to take advantage here. In the end I moved the heavy lifting to GHC.Core.Opt.Arity.findRhsArity; see Note [Combining arityType with demand info], and functions idDemandOneShots and combineWithDemandOneShots. (These changes partly drove my refactoring of ArityType.) * In GHC.Core.Opt.Arity.findRhsArity * I'm now taking account of the demand on the binder to give extra one-shot info. E.g. if the fn is always called with two args, we can give better one-shot info on the binders than if we just look at the RHS. * Don't do any fixpointing in the non-recursive case -- simple short cut. * Trim arity inside the loop. See Note [Trim arity inside the loop] * Make SimpleOpt respect the eta-reduction flag (Some associated refactoring here.) * I made the CallCtxt which the Simplifier uses distinguish between recursive and non-recursive right-hand sides. data CallCtxt = ... | RhsCtxt RecFlag | ... It affects only one thing: - We call an RHS context interesting only if it is non-recursive see Note [RHS of lets] in GHC.Core.Unfold * Remove eta-reduction in GHC.CoreToStg.Prep, a welcome simplification. See Note [No eta reduction needed in rhsToBody] in GHC.CoreToStg.Prep. Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. * Delete dead function GHC.Core.Opt.Simplify.Utils.contIsRhsOrArg Metrics: compile_time/bytes allocated Test Metric Baseline New value Change --------------------------------------------------------------------------------------- MultiLayerModulesTH_OneShot(normal) ghc/alloc 2,743,297,692 2,619,762,992 -4.5% GOOD T18223(normal) ghc/alloc 1,103,161,360 972,415,992 -11.9% GOOD T3064(normal) ghc/alloc 201,222,500 184,085,360 -8.5% GOOD T8095(normal) ghc/alloc 3,216,292,528 3,254,416,960 +1.2% T9630(normal) ghc/alloc 1,514,131,032 1,557,719,312 +2.9% BAD parsing001(normal) ghc/alloc 530,409,812 525,077,696 -1.0% geo. mean -0.1% Nofib: Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- banner +0.0% +0.4% -8.9% -8.7% 0.0% exact-reals +0.0% -7.4% -36.3% -37.4% 0.0% fannkuch-redux +0.0% -0.1% -1.0% -1.0% 0.0% fft2 -0.1% -0.2% -17.8% -19.2% 0.0% fluid +0.0% -1.3% -2.1% -2.1% 0.0% gg -0.0% +2.2% -0.2% -0.1% 0.0% spectral-norm +0.1% -0.2% 0.0% 0.0% 0.0% tak +0.0% -0.3% -9.8% -9.8% 0.0% x2n1 +0.0% -0.2% -3.2% -3.2% 0.0% -------------------------------------------------------------------------------- Min -3.5% -7.4% -58.7% -59.9% 0.0% Max +0.1% +2.2% +32.9% +32.9% 0.0% Geometric Mean -0.0% -0.1% -14.2% -14.8% -0.0% Metric Decrease: MultiLayerModulesTH_OneShot T18223 T3064 T15185 T14766 Metric Increase: T9630 - - - - - cac8c7bb by Matthew Pickering at 2022-05-30T13:44:50-04:00 hadrian: Fix building from source-dist without alex/happy This fixes two bugs which were adding dependencies on alex/happy when building from a source dist. * When we try to pass `--with-alex` and `--with-happy` to cabal when configuring but the builders are not set. This is fixed by making them optional. * When we configure, cabal requires alex/happy because of the build-tool-depends fields. These are now made optional with a cabal flag (build-tool-depends) for compiler/hpc-bin/genprimopcode. Fixes #21627 - - - - - a96dccfe by Matthew Pickering at 2022-05-30T13:44:50-04:00 ci: Test the bootstrap without ALEX/HAPPY on path - - - - - 0e5bb3a8 by Matthew Pickering at 2022-05-30T13:44:50-04:00 ci: Test bootstrapping in release jobs - - - - - d8901469 by Matthew Pickering at 2022-05-30T13:44:50-04:00 ci: Allow testing bootstrapping on MRs using the "test-bootstrap" label - - - - - 18326ad2 by Matthew Pickering at 2022-05-30T13:45:25-04:00 rts: Remove explicit timescale for deprecating -h flag We originally planned to remove the flag in 9.4 but there's actually no great rush to do so and it's probably less confusing (forever) to keep the message around suggesting an explicit profiling option. Fixes #21545 - - - - - eaaa1389 by Matthew Pickering at 2022-05-30T13:46:01-04:00 Enable -dlint in hadrian lint transformer Now #21563 is fixed we can properly enable `-dlint` in CI rather than a subset of the flags. - - - - - 0544f114 by Ben Gamari at 2022-05-30T19:16:55-04:00 upload-ghc-libs: Allow candidate-only upload - - - - - 83467435 by Sylvain Henry at 2022-05-30T19:17:35-04:00 Avoid using DynFlags in GHC.Linker.Unit (#17957) - - - - - 5c4421b1 by Matthew Pickering at 2022-05-31T08:35:17-04:00 hadrian: Introduce new package database for executables needed to build stage0 These executables (such as hsc2hs) are built using the boot compiler and crucially, most libraries from the global package database. We also move other build-time executables to be built in this stage such as linters which also cleans up which libraries end up in the global package database. This allows us to remove hacks where linters-common is removed from the package database when a bindist is created. This fixes issues caused by infinite recursion due to bytestring adding a dependency on template-haskell. Fixes #21634 - - - - - 0dafd3e7 by Matthew Pickering at 2022-05-31T08:35:17-04:00 Build stage1 with -V as well This helps tracing errors which happen when building stage1 - - - - - 15d42a7a by Matthew Pickering at 2022-05-31T08:35:52-04:00 Revert "packaging: Build perf builds with -split-sections" This reverts commit 699f593532a3cd5ca1c2fab6e6e4ce9d53be2c1f. Split sections causes segfaults in profiling way with old toolchains (deb9) and on windows (#21670) Fixes #21670 - - - - - d4c71f09 by John Ericson at 2022-05-31T16:26:28+00:00 Purge `DynFlags` and `HscEnv` from some `GHC.Core` modules where it's not too hard Progress towards #17957 Because of `CoreM`, I did not move the `DynFlags` and `HscEnv` to other modules as thoroughly as I usually do. This does mean that risk of `DynFlags` "creeping back in" is higher than it usually is. After we do the same process to the other Core passes, and then figure out what we want to do about `CoreM`, we can finish the job started here. That is a good deal more work, however, so it certainly makes sense to land this now. - - - - - a720322f by romes at 2022-06-01T07:44:44-04:00 Restore Note [Quasi-quote overview] - - - - - 392ce3fc by romes at 2022-06-01T07:44:44-04:00 Move UntypedSpliceFlavour from L.H.S to GHC.Hs UntypedSpliceFlavour was only used in the client-specific `GHC.Hs.Expr` but was defined in the client-independent L.H.S.Expr. - - - - - 7975202b by romes at 2022-06-01T07:44:44-04:00 TTG: Rework and improve splices This commit redefines the structure of Splices in the AST. We get rid of `HsSplice` which used to represent typed and untyped splices, quasi quotes, and the result of splicing either an expression, a type or a pattern. Instead we have `HsUntypedSplice` which models an untyped splice or a quasi quoter, which works in practice just like untyped splices. The `HsExpr` constructor `HsSpliceE` which used to be constructed with an `HsSplice` is split into `HsTypedSplice` and `HsUntypedSplice`. The former is directly constructed with an `HsExpr` and the latter now takes an `HsUntypedSplice`. Both `HsType` and `Pat` constructors `HsSpliceTy` and `SplicePat` now take an `HsUntypedSplice` instead of a `HsSplice` (remember only /untyped splices/ can be spliced as types or patterns). The result of splicing an expression, type, or pattern is now comfortably stored in the extension fields `XSpliceTy`, `XSplicePat`, `XUntypedSplice` as, respectively, `HsUntypedSpliceResult (HsType GhcRn)`, `HsUntypedSpliceResult (Pat GhcRn)`, and `HsUntypedSpliceResult (HsExpr GhcRn)` Overall the TTG extension points are now better used to make invalid states unrepresentable and model the progression between stages better. See Note [Lifecycle of an untyped splice, and PendingRnSplice] and Note [Lifecycle of an typed splice, and PendingTcSplice] for more details. Updates haddock submodule Fixes #21263 ------------------------- Metric Decrease: hard_hole_fits ------------------------- - - - - - 320270c2 by Matthew Pickering at 2022-06-01T07:44:44-04:00 Add test for #21619 Fixes #21619 - - - - - ef7ddd73 by Pierre Le Marre at 2022-06-01T07:44:47-04:00 Pure Haskell implementation of GHC.Unicode Switch to a pure Haskell implementation of base:GHC.Unicode, based on the implementation of the package unicode-data (https://github.com/composewell/unicode-data/). Approved by CLC as per https://github.com/haskell/core-libraries-committee/issues/59#issuecomment-1132106691. - Remove current Unicode cbits. - Add generator for Unicode property files from Unicode Character Database. - Generate internal modules. - Update GHC.Unicode. - Add unicode003 test for general categories and case mappings. - Add Python scripts to check 'base' Unicode tests outputs and characters properties. Fixes #21375 ------------------------- Metric Decrease: T16875 Metric Increase: T4029 T18304 haddock.base ------------------------- - - - - - 514a6a28 by Eric Lindblad at 2022-06-01T07:44:51-04:00 typos - - - - - 9004be3c by Matthew Pickering at 2022-06-01T07:44:52-04:00 source-dist: Copy in files created by ./boot Since we started producing source dists with hadrian we stopped copying in the files created by ./boot which adds a dependency on python3 and autoreconf. This adds back in the files which were created by running configure. Fixes #21673 #21672 and #21626 - - - - - a12a3cab by Matthew Pickering at 2022-06-01T07:44:52-04:00 ci: Don't try to run ./boot when testing bootstrap of source dist - - - - - e07f9059 by Shlomo Shuck at 2022-06-01T07:44:55-04:00 Language.Haskell.Syntax: Fix docs for PromotedConsT etc. Fixes ghc/ghc#21675. - - - - - 87295e6d by Ben Gamari at 2022-06-01T07:44:56-04:00 Bump bytestring, process, and text submodules Metric Decrease: T5631 Metric Increase: T18223 (cherry picked from commit 55fcee30cb3281a66f792e8673967d64619643af) - - - - - 24b5bb61 by Ben Gamari at 2022-06-01T07:44:56-04:00 Bump Cabal submodule To current `master`. (cherry picked from commit fbb59c212415188486aafd970eafef170516356a) - - - - - 5433a35e by Matthew Pickering at 2022-06-01T22:26:30-04:00 hadrian/tool-args: Write output to intermediate file rather than via stdout This allows us to see the output of hadrian while it is doing the setup. - - - - - 468f919b by Matthew Pickering at 2022-06-01T22:27:10-04:00 Make -fcompact-unwind the default This is a follow-up to !7247 (closed) making the inclusion of compact unwinding sections the default. Also a slight refactoring/simplification of the flag handling to add -fno-compact-unwind. - - - - - 819fdc61 by Zubin Duggal at 2022-06-01T22:27:47-04:00 hadrian bootstrap: add plans for 9.0.2 and 9.2.3 - - - - - 9fa790b4 by Zubin Duggal at 2022-06-01T22:27:47-04:00 ci: Add matrix for bootstrap sources - - - - - ce9f986b by John Ericson at 2022-06-02T15:42:59+00:00 HsToCore.Coverage: Improve haddocks - - - - - f065804e by John Ericson at 2022-06-02T15:42:59+00:00 Hoist auto `mkModBreaks` and `writeMixEntries` conditions to caller No need to inline traversing a maybe for `mkModBreaks`. And better to make each function do one thing and let the caller deside when than scatter the decision making and make the caller seem more imperative. - - - - - d550d907 by John Ericson at 2022-06-02T15:42:59+00:00 Rename `HsToCore.{Coverage -> Ticks}` The old name made it confusing why disabling HPC didn't disable the entire pass. The name makes it clear --- there are other reasons to add ticks in addition. - - - - - 6520da95 by John Ericson at 2022-06-02T15:42:59+00:00 Split out `GHC.HsToCore.{Breakpoints,Coverage}` and use `SizedSeq` As proposed in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7508#note_432877 and https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7508#note_434676, `GHC.HsToCore.Ticks` is about ticks, breakpoints are separate and backend-specific (only for the bytecode interpreter), and mix entry writing is just for HPC. With this split we separate out those interpreter- and HPC-specific its, and keep the main `GHC.HsToCore.Ticks` agnostic. Also, instead of passing the reversed list and count around, we use `SizedSeq` which abstracts over the algorithm. This is much nicer to avoid noise and prevents bugs. (The bugs are not just hypothetical! I missed up the reverses on an earlier draft of this commit.) - - - - - 1838c3d8 by Sylvain Henry at 2022-06-02T15:43:14+00:00 GHC.HsToCore.Breakpoints: Slightly improve perf We have the length already, so we might as well use that rather than O(n) recomputing it. - - - - - 5a3fdcfd by John Ericson at 2022-06-02T15:43:59+00:00 HsToCore.Coverage: Purge DynFlags Finishes what !7467 (closed) started. Progress towards #17957 - - - - - 9ce9ea50 by HaskellMouse at 2022-06-06T09:50:00-04:00 Deprecate TypeInType extension This commit fixes #20312 It deprecates "TypeInType" extension according to the following proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0083-no-type-in-type.rst It has been already implemented. The migration strategy: 1. Disable TypeInType 2. Enable both DataKinds and PolyKinds extensions Metric Decrease: T16875 - - - - - f2e037fd by Aaron Allen at 2022-06-06T09:50:39-04:00 Diagnostics conversions, part 6 (#20116) Replaces uses of `TcRnUnknownMessage` with proper diagnostics constructors in `GHC.Tc.Gen.Match`, `GHC.Tc.Gen.Pat`, and `GHC.Tc.Gen.Sig`. - - - - - 04209f2a by Simon Peyton Jones at 2022-06-06T09:51:15-04:00 Ensure floated dictionaries are in scope (again) In the Specialiser, we missed one more call to bringFloatedDictsIntoScope (see #21391). This omission led to #21689. The problem is that the call to `rewriteClassOps` needs to have in scope any dictionaries floated out of the arguments we have just specialised. Easy fix. - - - - - a7fece19 by John Ericson at 2022-06-07T05:04:22+00:00 Don't print the number of deps in count-deps tests It is redundant information and a source of needless version control conflicts when multiple MRs are changing the deps list. Just printing the list and not also its length is fine. - - - - - a1651a3a by John Ericson at 2022-06-07T05:06:38+00:00 Core.Lint: Reduce `DynFlags` and `HscEnv` Co-Authored-By: Andre Marianiello <andremarianiello at users.noreply.github.com> - - - - - 56ebf9a5 by Andreas Klebinger at 2022-06-09T09:11:43-04:00 Fix a CSE shadowing bug. We used to process the rhs of non-recursive bindings and their body using the same env. If we had something like let x = ... x ... this caused trouble because the two xs refer to different binders but we would substitute both for a new binder x2 causing out of scope errors. We now simply use two different envs for the rhs and body in cse_bind. It's all explained in the Note [Separate envs for let rhs and body] Fixes #21685 - - - - - 28880828 by sheaf at 2022-06-09T09:12:19-04:00 Typecheck remaining ValArgs in rebuildHsApps This patch refactors hasFixedRuntimeRep_remainingValArgs, renaming it to tcRemainingValArgs. The logic is moved to rebuildHsApps, which ensures consistent behaviour across tcApp and quickLookArg1/tcEValArg. This patch also refactors the treatment of stupid theta for data constructors, changing the place we drop stupid theta arguments from dsConLike to mkDataConRep (now the datacon wrapper drops these arguments). We decided not to implement PHASE 2 of the FixedRuntimeRep plan for these remaining ValArgs. Future directions are outlined on the wiki: https://gitlab.haskell.org/ghc/ghc/-/wikis/Remaining-ValArgs Fixes #21544 and #21650 - - - - - 1fbba97b by Matthew Pickering at 2022-06-09T09:12:54-04:00 Add test for T21682 Fixes #21682 - - - - - 8727be73 by Andreas Klebinger at 2022-06-09T09:13:29-04:00 Document dataToTag# primop - - - - - 7eab75bb by uhbif19 at 2022-06-09T20:22:47+03:00 Remove TcRnUnknownMessage usage from GHC.Rename.Env #20115 - - - - - 46d2fc65 by uhbif19 at 2022-06-09T20:24:40+03:00 Fix TcRnPragmaWarning meaning - - - - - 69e72ecd by Matthew Pickering at 2022-06-09T19:07:01-04:00 getProcessCPUTime: Fix the getrusage fallback to account for system CPU time clock_gettime reports the combined total or user AND system time so in order to replicate it with getrusage we need to add both system and user time together. See https://stackoverflow.com/questions/7622371/getrusage-vs-clock-gettime Some sample measurements when building Cabal with this patch t1: rusage t2: clock_gettime t1: 62347518000; t2: 62347520873 t1: 62395687000; t2: 62395690171 t1: 62432435000; t2: 62432437313 t1: 62478489000; t2: 62478492465 t1: 62514990000; t2: 62514992534 t1: 62515479000; t2: 62515480327 t1: 62515485000; t2: 62515486344 Fixes #21656 - - - - - 722814ba by Yiyun Liu at 2022-06-10T21:23:03-04:00 Use <br> instead of newline character - - - - - dc202080 by Matthew Craven at 2022-06-13T14:07:12-04:00 Use (fixed_lev = True) in mkDataTyConRhs - - - - - ad70c621 by Matthew Pickering at 2022-06-14T08:40:53-04:00 hadrian: Fix testing stage1 compiler There were various issues with testing the stage1 compiler.. 1. The wrapper was not being built 2. The wrapper was picking up the stage0 package database and trying to load prelude from that. 3. The wrappers never worked on windows so just don't support that for now. Fixes #21072 - - - - - ac83899d by Ben Gamari at 2022-06-14T08:41:30-04:00 validate: Ensure that $make variable is set Currently the `$make` variable is used without being set in `validate`'s Hadrian path, which uses make to install the binary distribution. Fix this. Fixes #21687. - - - - - 59bc6008 by John Ericson at 2022-06-15T18:05:35+00:00 CoreToStg.Prep: Get rid of `DynFlags` and `HscEnv` The call sites in `Driver.Main` are duplicative, but this is good, because the next step is to remove `InteractiveContext` from `Core.Lint` into `Core.Lint.Interactive`. Also further clean up `Core.Lint` to use a better configuration record than the one we initially added. - - - - - aa9d9381 by Ben Gamari at 2022-06-15T20:33:04-04:00 hadrian: Run xattr -rc . on bindist tarball Fixes #21506. - - - - - cdc75a1f by Ben Gamari at 2022-06-15T20:33:04-04:00 configure: Hide spurious warning from ld Previously the check_for_gold_t22266 configure check could result in spurious warnings coming from the linker being blurted to stderr. Suppress these by piping stderr to /dev/null. - - - - - e128b7b8 by Ben Gamari at 2022-06-15T20:33:40-04:00 cmm: Add surface syntax for MO_MulMayOflo - - - - - bde65ea9 by Ben Gamari at 2022-06-15T20:34:16-04:00 configure: Don't attempt to override linker on Darwin Configure's --enable-ld-override functionality is intended to ensure that we don't rely on ld.bfd, which tends to be slow and buggy, on Linux and Windows. However, on Darwin the lack of sensible package management makes it extremely easy for users to have awkward mixtures of toolchain components from, e.g., XCode, the Apple Command-Line Tools package, and homebrew. This leads to extremely confusing problems like #21712. Here we avoid this by simply giving up on linker selection on Darwin altogether. This isn't so bad since the Apple ld64 linker has decent performance and AFAICT fairly reliable. Closes #21712. - - - - - 25b510c3 by Torsten Schmits at 2022-06-16T12:37:45-04:00 replace quadratic nub to fight byte code gen perf explosion Despite this code having been present in the core-to-bytecode implementation, I have observed it in the wild starting with 9.2, causing enormous slowdown in certain situations. My test case produces the following profiles: Before: ``` total time = 559.77 secs (559766 ticks @ 1000 us, 1 processor) total alloc = 513,985,665,640 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc ticks bytes elem_by Data.OldList libraries/base/Data/OldList.hs:429:1-7 67.6 92.9 378282 477447404296 eqInt GHC.Classes libraries/ghc-prim/GHC/Classes.hs:275:8-14 12.4 0.0 69333 32 $c>>= GHC.Data.IOEnv <no location info> 6.9 0.6 38475 3020371232 ``` After: ``` total time = 89.83 secs (89833 ticks @ 1000 us, 1 processor) total alloc = 39,365,306,360 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc ticks bytes $c>>= GHC.Data.IOEnv <no location info> 43.6 7.7 39156 3020403424 doCase GHC.StgToByteCode compiler/GHC/StgToByteCode.hs:(805,1)-(1054,53) 2.5 7.4 2246 2920777088 ``` - - - - - aa7e1f20 by Matthew Pickering at 2022-06-16T12:38:21-04:00 hadrian: Don't install `include/` directory in bindist. The install_includes for the RTS package used to be put in the top-level ./include folder but this would lead to confusing things happening if you installed multiple GHC versions side-by-side. We don't need this folder anymore because install-includes is honoured properly by cabal and the relevant header files already copied in by the cabal installation process. If you want to depend on the header files for the RTS in a Haskell project then you just have to depend on the `rts` package and the correct include directories will be provided for you. If you want to depend on the header files in a standard C project then you should query ghc-pkg to get the right paths. ``` ghc-pkg field rts include-dirs --simple-output ``` Fixes #21609 - - - - - 03172116 by Bryan Richter at 2022-06-16T12:38:57-04:00 Enable eventlogs on nightly perf job - - - - - ecbf8685 by Hécate Moonlight at 2022-06-16T16:30:00-04:00 Repair dead link in TH haddocks Closes #21724 - - - - - 99ff3818 by sheaf at 2022-06-16T16:30:39-04:00 Hadrian: allow configuring Hsc2Hs This patch adds the ability to pass options to Hsc2Hs as Hadrian key/value settings, in the same way as cabal configure options, using the syntax: *.*.hsc2hs.run.opts += ... - - - - - 9c575f24 by sheaf at 2022-06-16T16:30:39-04:00 Hadrian bootstrap: look up hsc2hs Hadrian bootstrapping looks up where to find ghc_pkg, but the same logic was not in place for hsc2hs which meant we could fail to find the appropriate hsc2hs executabe when bootstrapping Hadrian. This patch adds that missing logic. - - - - - 229d741f by Ben Gamari at 2022-06-18T10:42:54-04:00 ghc-heap: Add (broken) test for #21622 - - - - - cadd7753 by Ben Gamari at 2022-06-18T10:42:54-04:00 ghc-heap: Don't Box NULL pointers Previously we could construct a `Box` of a NULL pointer from the `link` field of `StgWeak`. Now we take care to avoid ever introducing such pointers in `collect_pointers` and ensure that the `link` field is represented as a `Maybe` in the `Closure` type. Fixes #21622 - - - - - 31c214cc by Tamar Christina at 2022-06-18T10:43:34-04:00 winio: Add support to console handles to handleToHANDLE - - - - - 711cb417 by Ben Gamari at 2022-06-18T10:44:11-04:00 CmmToAsm/AArch64: Add SMUL[LH] instructions These will be needed to fix #21624. - - - - - d05d90d2 by Ben Gamari at 2022-06-18T10:44:11-04:00 CmmToAsm/AArch64: Fix syntax of OpRegShift operands Previously this produced invalid assembly containing a redundant comma. - - - - - a1e1d8ee by Ben Gamari at 2022-06-18T10:44:11-04:00 ncg/aarch64: Fix implementation of IntMulMayOflo The code generated for IntMulMayOflo was previously wrong as it depended upon the overflow flag, which the AArch64 MUL instruction does not set. Fix this. Fixes #21624. - - - - - 26745006 by Ben Gamari at 2022-06-18T10:44:11-04:00 testsuite: Add test for #21624 Ensuring that mulIntMayOflo# behaves as expected. - - - - - 94f2e92a by Sebastian Graf at 2022-06-20T09:40:58+02:00 CprAnal: Set signatures of DFuns to top The recursive DFun in the reproducer for #20836 also triggered a bug in CprAnal that is observable in a debug build. The CPR signature of a recursive DFunId was never updated and hence the optimistic arity 0 bottom signature triggered a mismatch with the arity 1 of the binding in WorkWrap. We never miscompiled any code because WW doesn't exploit bottom CPR signatures. - - - - - b570da84 by Sebastian Graf at 2022-06-20T09:43:29+02:00 CorePrep: Don't speculatively evaluate recursive calls (#20836) In #20836 we have optimised a terminating program into an endless loop, because we speculated the self-recursive call of a recursive DFun. Now we track the set of enclosing recursive binders in CorePrep to prevent speculation of such self-recursive calls. See the updates to Note [Speculative evaluation] for details. Fixes #20836. - - - - - 49fb2f9b by Sebastian Graf at 2022-06-20T09:43:32+02:00 Simplify: Take care with eta reduction in recursive RHSs (#21652) Similar to the fix to #20836 in CorePrep, we now track the set of enclosing recursive binders in the SimplEnv and SimpleOptEnv. See Note [Eta reduction in recursive RHSs] for details. I also updated Note [Arity robustness] with the insights Simon and I had in a call discussing the issue. Fixes #21652. Unfortunately, we get a 5% ghc/alloc regression in T16577. That is due to additional eta reduction in GHC.Read.choose1 and the resulting ANF-isation of a large list literal at the top-level that didn't happen before (presumably because it was too interesting to float to the top-level). There's not much we can do about that. Metric Increase: T16577 - - - - - 2563b95c by Sebastian Graf at 2022-06-20T09:45:09+02:00 Ignore .hie-bios - - - - - e4e44d8d by Simon Peyton Jones at 2022-06-20T12:31:45-04:00 Instantiate top level foralls in partial type signatures The main fix for #21667 is the new call to tcInstTypeBnders in tcHsPartialSigType. It was really a simple omission before. I also moved the decision about whether we need to apply the Monomorphism Restriction, from `decideGeneralisationPlan` to `tcPolyInfer`. That removes a flag from the InferGen constructor, which is good. But more importantly, it allows the new function, checkMonomorphismRestriction called from `tcPolyInfer`, to "see" the `Types` involved rather than the `HsTypes`. And that in turn matters because we invoke the MR for partial signatures if none of the partial signatures in the group have any overloading context; and we can't answer that question for HsTypes. See Note [Partial type signatures and the monomorphism restriction] in GHC.Tc.Gen.Bind. This latter is really a pre-existing bug. - - - - - 262a9f93 by Winston Hartnett at 2022-06-20T12:32:23-04:00 Make Outputable instance for InlineSig print the InlineSpec Fix ghc/ghc#21739 Squash fix ghc/ghc#21739 - - - - - b5590fff by Matthew Pickering at 2022-06-20T12:32:59-04:00 Add NO_BOOT to hackage_doc_tarball job We were attempting to boot a src-tarball which doesn't work as ./boot is not included in the source tarball. This slipped through as the job is only run on nightly. - - - - - d24afd9d by Vladislav Zavialov at 2022-06-20T17:34:44-04:00 HsToken for @-patterns and TypeApplications (#19623) One more step towards the new design of EPA. - - - - - 159b7628 by Tamar Christina at 2022-06-20T17:35:23-04:00 linker: only keep rtl exception tables if they have been relocated - - - - - da5ff105 by Andreas Klebinger at 2022-06-21T17:04:12+02:00 Ticky:Make json info a separate field. - - - - - 1a4ce4b2 by Matthew Pickering at 2022-06-22T09:49:22+01:00 Revert "Ticky:Make json info a separate field." This reverts commit da5ff10503e683e2148c62e36f8fe2f819328862. This was pushed directly without review. - - - - - f89bf85f by Vanessa McHale at 2022-06-22T08:21:32-04:00 Flags to disable local let-floating; -flocal-float-out, -flocal-float-out-top-level CLI flags These flags affect the behaviour of local let floating. If `-flocal-float-out` is disabled (the default) then we disable all local floating. ``` …(let x = let y = e in (a,b) in body)... ===> …(let y = e; x = (a,b) in body)... ``` Further to this, top-level local floating can be disabled on it's own by passing -fno-local-float-out-top-level. ``` x = let y = e in (a,b) ===> y = e; x = (a,b) ``` Note that this is only about local floating, ie, floating two adjacent lets past each other and doesn't say anything about the global floating pass which is controlled by `-fno-float`. Fixes #13663 - - - - - 4ccefc6e by Matthew Craven at 2022-06-22T08:22:12-04:00 Check for Int overflows in Data.Array.Byte - - - - - 2004e3c8 by Matthew Craven at 2022-06-22T08:22:12-04:00 Add a basic test for ByteArray's Monoid instance - - - - - fb36770c by Matthew Craven at 2022-06-22T08:22:12-04:00 Rename `copyByteArray` to `unsafeCopyByteArray` - - - - - ecc9aedc by Ben Gamari at 2022-06-22T08:22:48-04:00 testsuite: Add test for #21719 Happily, this has been fixed since 9.2. - - - - - 19606c42 by Brandon Chinn at 2022-06-22T08:23:28-04:00 Use lookupNameCache instead of lookupOrigIO - - - - - 4c9dfd69 by Brandon Chinn at 2022-06-22T08:23:28-04:00 Break out thNameToGhcNameIO (ref. #21730) - - - - - eb4fb849 by Michael Peyton Jones at 2022-06-22T08:24:07-04:00 Add laws for 'toInteger' and 'toRational' CLC discussion here: https://github.com/haskell/core-libraries-committee/issues/58 - - - - - c1a950c1 by Alexander Esgen at 2022-06-22T12:36:13+00:00 Correct documentation of defaults of the `-V` RTS option - - - - - b7b7d90d by Matthew Pickering at 2022-06-22T21:58:12-04:00 Transcribe discussion from #21483 into a Note In #21483 I had a discussion with Simon Marlow about the memory retention behaviour of -Fd. I have just transcribed that conversation here as it elucidates the potentially subtle assumptions which led to the design of the memory retention behaviours of -Fd. Fixes #21483 - - - - - 980d1954 by Ben Gamari at 2022-06-22T21:58:48-04:00 eventlog: Don't leave dangling pointers hanging around Previously we failed to reset pointers to various eventlog buffers to NULL after freeing them. In principle we shouldn't look at them after they are freed but nevertheless it is good practice to set them to a well-defined value. - - - - - 575ec846 by Eric Lindblad at 2022-06-22T21:59:28-04:00 runhaskell - - - - - e6a69337 by Artem Pelenitsyn at 2022-06-22T22:00:07-04:00 re-export GHC.Natural.minusNaturalMaybe from Numeric.Natural CLC proposal: https://github.com/haskell/core-libraries-committee/issues/45 - - - - - 5d45aa97 by Gergo ERDI at 2022-06-22T22:00:46-04:00 When specialising, look through floatable ticks. Fixes #21697. - - - - - 531205ac by Andreas Klebinger at 2022-06-22T22:01:22-04:00 TagCheck.hs: Properly check if arguments are boxed types. For one by mistake I had been checking against the kind of runtime rep instead of the boxity. This uncovered another bug, namely that we tried to generate the checking code before we had associated the function arguments with a register, so this could never have worked to begin with. This fixes #21729 and both of the above issues. - - - - - c7f9f6b5 by Gleb Popov at 2022-06-22T22:02:00-04:00 Use correct arch for the FreeBSD triple in gen-data-layout.sh Downstream bug for reference: https://bugs.freebsd.org/bugzilla/show_bug.cgi?id=261798 Relevant upstream issue: #15718 - - - - - 75f0091b by Andreas Klebinger at 2022-06-22T22:02:35-04:00 Bump nofib submodule. Allows the shake runner to build with 9.2.3 among other things. Fixes #21772 - - - - - 0aa0ce69 by Ben Gamari at 2022-06-27T08:01:03-04:00 Bump ghc-prim and base versions To 0.9.0 and 4.17.0 respectively. Bumps array, deepseq, directory, filepath, haskeline, hpc, parsec, stm, terminfo, text, unix, haddock, and hsc2hs submodules. (cherry picked from commit ba47b95122b7b336ce1cc00896a47b584ad24095) - - - - - 4713abc2 by Ben Gamari at 2022-06-27T08:01:03-04:00 testsuite: Use normalise_version more consistently Previously several tests' output were unnecessarily dependent on version numbers, particularly of `base`. Fix this. - - - - - d7b0642b by Matthew Pickering at 2022-06-27T08:01:03-04:00 linters: Fix lint-submodule-refs when crashing trying to find plausible branches - - - - - 38378be3 by Andreas Klebinger at 2022-06-27T08:01:39-04:00 hadrian: Improve haddocks for ghcDebugAssertions - - - - - ac7a7fc8 by Andreas Klebinger at 2022-06-27T08:01:39-04:00 Don't mark lambda binders as OtherCon We used to put OtherCon unfoldings on lambda binders of workers and sometimes also join points/specializations with with the assumption that since the wrapper would force these arguments once we execute the RHS they would indeed be in WHNF. This was wrong for reasons detailed in #21472. So now we purge evaluated unfoldings from *all* lambda binders. This fixes #21472, but at the cost of sometimes not using as efficient a calling convention. It can also change inlining behaviour as some occurances will no longer look like value arguments when they did before. As consequence we also change how we compute CBV information for arguments slightly. We now *always* determine the CBV convention for arguments during tidy. Earlier in the pipeline we merely mark functions as candidates for having their arguments treated as CBV. As before the process is described in the relevant notes: Note [CBV Function Ids] Note [Attaching CBV Marks to ids] Note [Never put `OtherCon` unfoldigns on lambda binders] ------------------------- Metric Decrease: T12425 T13035 T18223 T18223 T18923 MultiLayerModulesTH_OneShot Metric Increase: WWRec ------------------------- - - - - - 06cf6f4a by Tony Zorman at 2022-06-27T08:02:18-04:00 Add suggestions for unrecognised pragmas (#21589) In case of a misspelled pragma, offer possible corrections as to what the user could have meant. Fixes: https://gitlab.haskell.org/ghc/ghc/-/issues/21589 - - - - - 3fbab757 by Greg Steuck at 2022-06-27T08:02:56-04:00 Remove the traces of i386-*-openbsd, long live amd64 OpenBSD will not ship any ghc packages on i386 starting with 7.2 release. This means there will not be a bootstrap compiler easily available. The last available binaries are ghc-8.10.6 which is already not supported as bootstrap for HEAD. See here for more information: https://marc.info/?l=openbsd-ports&m=165060700222580&w=2 - - - - - 58530271 by Bodigrim at 2022-06-27T08:03:34-04:00 Add Foldable1 and Bifoldable1 type classes Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/9 Instances roughly follow https://hackage.haskell.org/package/semigroupoids-5.3.7/docs/Data-Semigroup-Foldable-Class.html#t:Foldable1 but the API of `Foldable1` was expanded in comparison to `semigroupoids`. Compatibility shim is available from https://github.com/phadej/foldable1 (to be released). Closes #13573. - - - - - a51f4ecc by Naomi Liu at 2022-06-27T08:04:13-04:00 add levity polymorphism to addrToAny# - - - - - f4edcdc4 by Naomi Liu at 2022-06-27T08:04:13-04:00 add tests for addrToAny# levity - - - - - 07016fc9 by Matthew Pickering at 2022-06-27T08:04:49-04:00 hadrian: Update main README page This README had some quite out-of-date content about the build system so I did a complete pass deleting old material. I also made the section about flavours more prominent and mentioned flavour transformers. - - - - - 79ae2d89 by Ben Gamari at 2022-06-27T08:05:24-04:00 testsuite: Hide output from test compilations with verbosity==2 Previously the output from test compilations used to determine whether, e.g., profiling libraries are available was shown with verbosity levels >= 2. However, the default level is 2, meaning that most users were often spammed with confusing errors. Fix this by bumping the verbosity threshold for this output to >=3. Fixes #21760. - - - - - 995ea44d by Ben Gamari at 2022-06-27T08:06:00-04:00 configure: Only probe for LD in FIND_LD Since 6be2c5a7e9187fc14d51e1ec32ca235143bb0d8b we would probe for LD rather early in `configure`. However, it turns out that this breaks `configure`'s `ld`-override logic, which assumes that `LD` was set by the user and aborts. Fixes #21778. - - - - - b43d140b by Sergei Trofimovich at 2022-06-27T08:06:39-04:00 `.hs-boot` make rules: add missing order-only dependency on target directory Noticed missing target directory dependency as a build failure in `make --shuffle` mode (added in https://savannah.gnu.org/bugs/index.php?62100): "cp" libraries/base/./GHC/Stack/CCS.hs-boot libraries/base/dist-install/build/GHC/Stack/CCS.hs-boot cp: cannot create regular file 'libraries/base/dist-install/build/GHC/Stack/CCS.hs-boot': No such file or directory libraries/haskeline/ghc.mk:4: libraries/haskeline/dist-install/build/.depend-v-p-dyn.haskell: No such file or directory make[1]: *** [libraries/base/ghc.mk:4: libraries/base/dist-install/build/GHC/Stack/CCS.hs-boot] Error 1 shuffle=1656129254 make: *** [Makefile:128: all] Error 2 shuffle=1656129254 Note that `cp` complains about inability to create target file. The change adds order-only dependency on a target directory (similar to the rest of rules in that file). The bug is lurking there since 2009 commit 34cc75e1a (`GHC new build system megapatch`.) where upfront directory creation was never added to `.hs-boot` files. - - - - - 57a5f88c by Ben Gamari at 2022-06-28T03:24:24-04:00 Mark AArch64/Darwin as requiring sign-extension Apple's AArch64 ABI requires that the caller sign-extend small integer arguments. Set platformCConvNeedsExtension to reflect this fact. Fixes #21773. - - - - - df762ae9 by Ben Gamari at 2022-06-28T03:24:24-04:00 -ddump-llvm shouldn't imply -fllvm Previously -ddump-llvm would change the backend used, which contrasts with all other dump flags. This is quite surprising and cost me quite a bit of time. Dump flags should not change compiler behavior. Fixes #21776. - - - - - 70f0c1f8 by Ben Gamari at 2022-06-28T03:24:24-04:00 CmmToAsm/AArch64: Re-format argument handling logic Previously there were very long, hard to parse lines. Fix this. - - - - - 696d64c3 by Ben Gamari at 2022-06-28T03:24:24-04:00 CmmToAsm/AArch64: Sign-extend narrow C arguments The AArch64/Darwin ABI requires that function arguments narrower than 32-bits must be sign-extended by the caller. We neglected to do this, resulting in #20735. Fixes #20735. - - - - - c006ac0d by Ben Gamari at 2022-06-28T03:24:24-04:00 testsuite: Add test for #20735 - - - - - 16b9100c by Ben Gamari at 2022-06-28T03:24:59-04:00 integer-gmp: Fix cabal file Evidently fields may not come after sections in a cabal file. - - - - - 03cc5d02 by Sergei Trofimovich at 2022-06-28T15:20:45-04:00 ghc.mk: fix 'make install' (`mk/system-cxx-std-lib-1.0.conf.install` does not exist) before the change `make install` was failing as: ``` "mv" "/<<NIX>>/ghc-9.3.20220406/lib/ghc-9.5.20220625/bin/ghc-stage2" "/<<NIX>>/ghc-9.3.20220406/lib/ghc-9.5.20220625/bin/ghc" make[1]: *** No rule to make target 'mk/system-cxx-std-lib-1.0.conf.install', needed by 'install_packages'. Stop. ``` I think it's a recent regression caused by 0ef249aa where `system-cxx-std-lib-1.0.conf` is created (somewhat manually), but not the .install varianlt of it. The fix is to consistently use `mk/system-cxx-std-lib-1.0.conf` everywhere. Closes: https://gitlab.haskell.org/ghc/ghc/-/issues/21784 - - - - - eecab8f9 by Simon Peyton Jones at 2022-06-28T15:21:21-04:00 Comments only, about join points This MR just adds some documentation about why casts destroy join points, following #21716. - - - - - 251471e7 by Matthew Pickering at 2022-06-28T19:02:41-04:00 Cleanup BuiltInSyntax vs UserSyntax There was some confusion about whether FUN/TYPE/One/Many should be BuiltInSyntax or UserSyntax. The answer is certainly UserSyntax as BuiltInSyntax is for things which are directly constructed by the parser rather than going through normal renaming channels. I fixed all the obviously wrong places I could find and added a test for the original bug which was caused by this (#21752) Fixes #21752 #20695 #18302 - - - - - 0e22f16c by Ben Gamari at 2022-06-28T19:03:16-04:00 template-haskell: Bump version to 2.19.0.0 Bumps text and exceptions submodules due to bounds. - - - - - bbe6f10e by Emily Bourke at 2022-06-29T08:23:13+00:00 Tiny tweak to `IOPort#` documentation The exclamation mark and bracket don’t seem to make sense here. I’ve looked through the history, and I don’t think they’re deliberate – possibly a copy-and-paste error. - - - - - 70e47489 by Dominik Peteler at 2022-06-29T19:26:31-04:00 Remove `CoreOccurAnal` constructor of the `CoreToDo` type It was dead code since the last occurence in an expression context got removed in 71916e1c018dded2e68d6769a2dbb8777da12664. - - - - - d0722170 by nineonine at 2022-07-01T08:15:56-04:00 Fix panic with UnliftedFFITypes+CApiFFI (#14624) When declaring foreign import using CAPI calling convention, using unlifted unboxed types would result in compiler panic. There was an attempt to fix the situation in #9274, however it only addressed some of the ByteArray cases. This patch fixes other missed cases for all prims that may be used as basic foreign types. - - - - - eb043148 by Douglas Wilson at 2022-07-01T08:16:32-04:00 rts: gc stats: account properly for copied bytes in sequential collections We were not updating the [copied,any_work,scav_find_work, max_n_todo_overflow] counters during sequential collections. As well, we were double counting for parallel collections. To fix this we add an `else` clause to the `if (is_par_gc())`. The par_* counters do not need to be updated in the sequential case because they must be 0. - - - - - f95edea9 by Matthew Pickering at 2022-07-01T19:21:55-04:00 desugar: Look through ticks when warning about possible literal overflow Enabling `-fhpc` or `-finfo-table-map` would case a tick to end up between the appliation of `neg` to its argument. This defeated the special logic which looks for `NegApp ... (HsOverLit` to warn about possible overflow if a user writes a negative literal (without out NegativeLiterals) in their code. Fixes #21701 - - - - - f25c8d03 by Matthew Pickering at 2022-07-01T19:22:31-04:00 ci: Fix definition of slow-validate flavour (so that -dlint) is passed In this embarassing sequence of events we were running slow-validate without -dlint. - - - - - bf7991b0 by Mike Pilgrem at 2022-07-02T10:12:04-04:00 Identify the extistence of the `runhaskell` command and that it is equivalent to the `runghc` command. Add an entry to the index for `runhaskell`. See https://gitlab.haskell.org/ghc/ghc/-/issues/21411 - - - - - 9e79f6d0 by Simon Jakobi at 2022-07-02T10:12:39-04:00 Data.Foldable1: Remove references to Foldable-specific note ...as discussed in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/8495#note_439455. - - - - - 3a8970ac by romes at 2022-07-03T14:11:31-04:00 TTG: Move HsModule to L.H.S Move the definition of HsModule defined in GHC.Hs to Language.Haskell.Syntax with an added TTG parameter and corresponding extension fields. This is progress towards having the haskell-syntax package, as described in #21592 - - - - - f9f80995 by romes at 2022-07-03T14:11:31-04:00 TTG: Move ImpExp client-independent bits to L.H.S.ImpExp Move the GHC-independent definitions from GHC.Hs.ImpExp to Language.Haskell.Syntax.ImpExp with the required TTG extension fields such as to keep the AST independent from GHC. This is progress towards having the haskell-syntax package, as described in #21592 Bumps haddock submodule - - - - - c43dbac0 by romes at 2022-07-03T14:11:31-04:00 Refactor ModuleName to L.H.S.Module.Name ModuleName used to live in GHC.Unit.Module.Name. In this commit, the definition of ModuleName and its associated functions are moved to Language.Haskell.Syntax.Module.Name according to the current plan towards making the AST GHC-independent. The instances for ModuleName for Outputable, Uniquable and Binary were moved to the module in which the class is defined because these instances depend on GHC. The instance of Eq for ModuleName is slightly changed to no longer depend on unique explicitly and instead uses FastString's instance of Eq. - - - - - 2635c6f2 by konsumlamm at 2022-07-03T14:12:11-04:00 Expand `Ord` instance for `Down` Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/23#issuecomment-1172932610 - - - - - 36fba0df by Anselm Schüler at 2022-07-04T05:06:42+00:00 Add applyWhen to Data.Function per CLC prop Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/71#issuecomment-1165830233 - - - - - 3b13aab1 by Matthew Pickering at 2022-07-04T15:15:00-04:00 hadrian: Don't read package environments in ghc-stage1 wrapper The stage1 compiler may be on the brink of existence and not have even a working base library. You may have installed packages globally with a similar stage2 compiler which will then lead to arguments such as --show-iface not even working because you are passing too many package flags. The solution is simple, don't read these implicit files. Fixes #21803 - - - - - aba482ea by Andreas Klebinger at 2022-07-04T17:55:55-04:00 Ticky:Make json info a separate field. Fixes #21233 - - - - - 74f3867d by Matthew Pickering at 2022-07-04T17:56:30-04:00 Add docs:<pkg> command to hadrian to build docs for just one package - - - - - 418afaf1 by Matthew Pickering at 2022-07-04T17:56:30-04:00 upload-docs: propagate publish correctly in upload_sdist - - - - - ed793d7a by Matthew Pickering at 2022-07-04T17:56:30-04:00 docs-upload: Fix upload script when no packages are listed - - - - - d002c6e0 by Matthew Pickering at 2022-07-04T17:56:30-04:00 hadrian: Add --haddock-base-url option for specifying base-url when generating docs The motiviation for this flag is to be able to produce documentation which is suitable for uploading for hackage, ie, the cross-package links work correctly. There are basically three values you want to set this to: * off - default, base_url = ../%pkg% which works for local browsing * on - no argument , base_url = https:://hackage.haskell.org/package/%pkg%/docs - for hackage docs upload * on - argument, for example, base_url = http://localhost:8080/package/%pkg%/docs for testing the documentation. The `%pkg%` string is a template variable which is replaced with the package identifier for the relevant package. This is one step towards fixing #21749 - - - - - 41eb749a by Matthew Pickering at 2022-07-04T17:56:31-04:00 Add nightly job for generating docs suitable for hackage upload - - - - - 620ee7ed by Matthew Pickering at 2022-07-04T17:57:05-04:00 ghci: Support :set prompt in multi repl This adds supports for various :set commands apart from `:set <FLAG>` in multi repl, this includes `:set prompt` and so-on. Fixes #21796 - - - - - b151b65e by Matthew Pickering at 2022-07-05T16:32:31-04:00 Vendor filepath inside template-haskell Adding filepath as a dependency of template-haskell means that it can't be reinstalled if any build-plan depends on template-haskell. This is a temporary solution for the 9.4 release. A longer term solution is to split-up the template-haskell package into the wired-in part and a non-wired-in part which can be reinstalled. This was deemed quite risky on the 9.4 release timescale. Fixes #21738 - - - - - c9347ecf by John Ericson at 2022-07-05T16:33:07-04:00 Factor fields of `CoreDoSimplify` into separate data type This avoids some partiality. The work @mmhat is doing cleaning up and modularizing `Core.Opt` will build on this nicely. - - - - - d0e74992 by Eric Lindblad at 2022-07-06T01:35:48-04:00 https urls - - - - - 803e965c by Eric Lindblad at 2022-07-06T01:35:48-04:00 options and typos - - - - - 5519baa5 by Eric Lindblad at 2022-07-06T01:35:48-04:00 grammar - - - - - 4ddc1d3e by Eric Lindblad at 2022-07-06T01:35:48-04:00 sources - - - - - c95c2026 by Matthew Pickering at 2022-07-06T01:35:48-04:00 Fix lint warnings in bootstrap.py - - - - - 86ced2ad by romes at 2022-07-06T01:36:23-04:00 Restore Eq instance of ImportDeclQualifiedStyle Fixes #21819 - - - - - 3547e264 by romes at 2022-07-06T13:50:27-04:00 Prune L.H.S modules of GHC dependencies Move around datatypes, functions and instances that are GHC-specific out of the `Language.Haskell.Syntax.*` modules to reduce the GHC dependencies in them -- progressing towards #21592 Creates a module `Language.Haskell.Syntax.Basic` to hold basic definitions required by the other L.H.S modules (and don't belong in any of them) - - - - - e4eea07b by romes at 2022-07-06T13:50:27-04:00 TTG: Move CoreTickish out of LHS.Binds Remove the `[CoreTickish]` fields from datatype `HsBindLR idL idR` and move them to the extension point instance, according to the plan outlined in #21592 to separate the base AST from the GHC specific bits. - - - - - acc1816b by romes at 2022-07-06T13:50:27-04:00 TTG for ForeignImport/Export Add a TTG parameter to both `ForeignImport` and `ForeignExport` and, according to #21592, move the GHC-specific bits in them and in the other AST data types related to foreign imports and exports to the TTG extension point. - - - - - 371c5ecf by romes at 2022-07-06T13:50:27-04:00 TTG for HsTyLit Add TTG parameter to `HsTyLit` to move the GHC-specific `SourceText` fields to the extension point and out of the base AST. Progress towards #21592 - - - - - fd379d1b by romes at 2022-07-06T13:50:27-04:00 Remove many GHC dependencies from L.H.S Continue to prune the `Language.Haskell.Syntax.*` modules out of GHC imports according to the plan in the linked issue. Moves more GHC-specific declarations to `GHC.*` and brings more required GHC-independent declarations to `Language.Haskell.Syntax.*` (extending e.g. `Language.Haskell.Syntax.Basic`). Progress towards #21592 Bump haddock submodule for !8308 ------------------------- Metric Decrease: hard_hole_fits ------------------------- - - - - - c5415bc5 by Alan Zimmerman at 2022-07-06T13:50:27-04:00 Fix exact printing of the HsRule name Prior to this branch, the HsRule name was XRec pass (SourceText,RuleName) and there is an ExactPrint instance for (SourceText, RuleName). The SourceText has moved to a different location, so synthesise the original to trigger the correct instance when printing. We need both the SourceText and RuleName when exact printing, as it is possible to have a NoSourceText variant, in which case we fall back to the FastString. - - - - - 665fa5a7 by Matthew Pickering at 2022-07-06T13:51:03-04:00 driver: Fix issue with module loops and multiple home units We were attempting to rehydrate all dependencies of a particular module, but we actually only needed to rehydrate those of the current package (as those are the ones participating in the loop). This fixes loading GHC into a multi-unit session. Fixes #21814 - - - - - bbcaba6a by Andreas Klebinger at 2022-07-06T13:51:39-04:00 Remove a bogus #define from ClosureMacros.h - - - - - fa59223b by Tamar Christina at 2022-07-07T23:23:57-04:00 winio: make consoleReadNonBlocking not wait for any events at all. - - - - - 42c917df by Adam Sandberg Ericsson at 2022-07-07T23:24:34-04:00 rts: allow NULL to be used as an invalid StgStablePtr - - - - - 3739e565 by Andreas Schwab at 2022-07-07T23:25:10-04:00 RTS: Add stack marker to StgCRunAsm.S Every object file must be properly marked for non-executable stack, even if it contains no code. - - - - - a889bc05 by Ben Gamari at 2022-07-07T23:25:45-04:00 Bump unix submodule Adds `config.sub` to unix's `.gitignore`, fixing #19574. - - - - - 3609a478 by Matthew Pickering at 2022-07-09T11:11:58-04:00 ghci: Fix most calls to isLoaded to work in multi-mode The most egrarious thing this fixes is the report about the total number of loaded modules after starting a session. Ticket #20889 - - - - - fc183c90 by Matthew Pickering at 2022-07-09T11:11:58-04:00 Enable :edit command in ghci multi-mode. This works after the last change to isLoaded. Ticket #20888 - - - - - 46050534 by Simon Peyton Jones at 2022-07-09T11:12:34-04:00 Fix a scoping bug in the Specialiser In the call to `specLookupRule` in `already_covered`, in `specCalls`, we need an in-scope set that includes the free vars of the arguments. But we simply were not guaranteeing that: did not include the `rule_bndrs`. Easily fixed. I'm not sure how how this bug has lain for quite so long without biting us. Fixes #21828. - - - - - 6e8d9056 by Simon Peyton Jones at 2022-07-12T13:26:52+00:00 Edit Note [idArity varies independently of dmdTypeDepth] ...and refer to it in GHC.Core.Lint.lintLetBind. Fixes #21452 - - - - - 89ba4655 by Simon Peyton Jones at 2022-07-12T13:26:52+00:00 Tiny documentation wibbles (comments only) - - - - - 61a46c6d by Eric Lindblad at 2022-07-13T08:28:29-04:00 fix readme - - - - - 61babb5e by Eric Lindblad at 2022-07-13T08:28:29-04:00 fix bootstrap - - - - - 8b417ad5 by Eric Lindblad at 2022-07-13T08:28:29-04:00 tarball - - - - - e9d9f078 by Zubin Duggal at 2022-07-13T14:00:18-04:00 hie-files: Fix scopes for deriving clauses and instance signatures (#18425) - - - - - c4989131 by Zubin Duggal at 2022-07-13T14:00:18-04:00 hie-files: Record location of filled in default method bindings This is useful for hie files to reconstruct the evidence that default methods depend on. - - - - - 9c52e7fc by Zubin Duggal at 2022-07-13T14:00:18-04:00 testsuite: Factor out common parts from hiefile tests - - - - - 6a9e4493 by sheaf at 2022-07-13T14:00:56-04:00 Hadrian: update documentation of settings The documentation for key-value settings was a bit out of date. This patch updates it to account for `cabal.configure.opts` and `hsc2hs.run.opts`. The user-settings document was also re-arranged, to make the key-value settings more prominent (as it doesn't involve changing the Hadrian source code, and thus doesn't require any recompilation of Hadrian). - - - - - a2f142f8 by Zubin Duggal at 2022-07-13T20:43:32-04:00 Fix potential space leak that arise from ModuleGraphs retaining references to previous ModuleGraphs, in particular the lazy `mg_non_boot` field. This manifests in `extendMG`. Solution: Delete `mg_non_boot` as it is only used for `mgLookupModule`, which is only called in two places in the compiler, and should only be called at most once for every home unit: GHC.Driver.Make: mainModuleSrcPath :: Maybe String mainModuleSrcPath = do ms <- mgLookupModule mod_graph (mainModIs hue) ml_hs_file (ms_location ms) GHCI.UI: listModuleLine modl line = do graph <- GHC.getModuleGraph let this = GHC.mgLookupModule graph modl Instead `mgLookupModule` can be a linear function that looks through the entire list of `ModuleGraphNodes` Fixes #21816 - - - - - dcf8b30a by Ben Gamari at 2022-07-13T20:44:08-04:00 rts: Fix AdjustorPool bitmap manipulation Previously the implementation of bitmap_first_unset assumed that `__builtin_clz` would accept `uint8_t` however it apparently rather extends its argument to `unsigned int`. To fix this we simply revert to a naive implementation since handling the various corner cases with `clz` is quite tricky. This should be fine given that AdjustorPool isn't particularly hot. Ideally we would have a single, optimised bitmap implementation in the RTS but I'll leave this for future work. Fixes #21838. - - - - - ad8f3e15 by Luite Stegeman at 2022-07-16T07:20:36-04:00 Change GHCi bytecode return convention for unlifted datatypes. This changes the bytecode return convention for unlifted algebraic datatypes to be the same as for lifted types, i.e. ENTER/PUSH_ALTS instead of RETURN_UNLIFTED/PUSH_ALTS_UNLIFTED Fixes #20849 - - - - - 5434d1a3 by Colten Webb at 2022-07-16T07:21:15-04:00 Compute record-dot-syntax types Ensures type information for record-dot-syntax is included in HieASTs. See #21797 - - - - - 89d169ec by Colten Webb at 2022-07-16T07:21:15-04:00 Add record-dot-syntax test - - - - - 4beb9f3c by Ben Gamari at 2022-07-16T07:21:51-04:00 Document RuntimeRep polymorphism limitations of catch#, et al As noted in #21868, several primops accepting continuations producing RuntimeRep-polymorphic results aren't nearly as polymorphic as their types suggest. Document this limitation and adapt the `UnliftedWeakPtr` test to avoid breaking this limitation in `keepAlive#`. - - - - - 4ef1c65d by Ben Gamari at 2022-07-16T07:21:51-04:00 Make keepAlive# out-of-line This is a naive approach to fixing the unsoundness noticed in #21708. Specifically, we remove the lowering of `keepAlive#` via CorePrep and instead turn it into an out-of-line primop. This is simple, inefficient (since the continuation must now be heap allocated), but good enough for 9.4.1. We will revisit this (particiularly via #16098) in a future release. Metric Increase: T4978 T7257 T9203 - - - - - 1bbff35d by Greg Steuck at 2022-07-16T07:22:29-04:00 Suppress extra output from configure check for c++ libraries - - - - - 3acbd7ad by Ben Gamari at 2022-07-16T07:23:04-04:00 rel-notes: Drop mention of #21745 fix Since we have backported the fix to 9.4.1. - - - - - b27c2774 by Dominik Peteler at 2022-07-16T07:23:43-04:00 Align the behaviour of `dopt` and `log_dopt` Before the behaviour of `dopt` and `logHasDumpFlag` (and the underlying function `log_dopt`) were different as the latter did not take the verbosity level into account. This led to problems during the refactoring as we cannot simply replace calls to `dopt` with calls to `logHasDumpFlag`. In addition to that a subtle bug in the GHC module was fixed: `setSessionDynFlags` did not update the logger and as a consequence the verbosity value of the logger was not set appropriately. Fixes #21861 - - - - - 28347d71 by Douglas Wilson at 2022-07-16T13:25:06-04:00 rts: forkOn context switches the target capability Fixes #21824 - - - - - f1c44991 by Ben Gamari at 2022-07-16T13:25:41-04:00 cmm: Eliminate orphan Outputable instances Here we reorganize `GHC.Cmm` to eliminate the orphan `Outputable` and `OutputableP` instances for the Cmm AST. This makes it significantly easier to use the Cmm pretty-printers in tracing output without incurring module import cycles. - - - - - f2e5e763 by Ben Gamari at 2022-07-16T13:25:41-04:00 cmm: Move toBlockList to GHC.Cmm - - - - - fa092745 by Ben Gamari at 2022-07-16T13:25:41-04:00 compiler: Add haddock sections to GHC.Utils.Panic - - - - - 097759f9 by Ben Gamari at 2022-07-16T13:26:17-04:00 configure: Don't override Windows CXXFLAGS At some point we used the clang distribution from msys2's `MINGW64` environment for our Windows toolchain. This defaulted to using libgcc and libstdc++ for its runtime library. However, we found for a variety of reasons that compiler-rt, libunwind, and libc++ were more reliable, consequently we explicitly overrode the CXXFLAGS to use these. However, since then we have switched to use the `CLANG64` packaging, which default to these already. Consequently we can drop these arguments, silencing some redundant argument warnings from clang. Fixes #21669. - - - - - e38a2684 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/Elf: Check that there are no NULL ctors - - - - - 616365b0 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/Elf: Introduce support for invoking finalizers on unload Addresses #20494. - - - - - cdd3be20 by Ben Gamari at 2022-07-16T23:50:36-04:00 testsuite: Add T20494 - - - - - 03c69d8d by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Rename finit field to fini fini is short for "finalizer", which does not contain a "t". - - - - - 033580bc by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Refactor handling of oc->info Previously we would free oc->info after running initializers. However, we can't do this is we want to also run finalizers. Moreover, freeing oc->info so early was wrong for another reason: we will need it in order to unregister the exception tables (see the call to `RtlDeleteFunctionTable`). In service of #20494. - - - - - f17912e4 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Add finalization support This implements #20494 for the PEi386 linker. Happily, this also appears to fix `T9405`, resolving #21361. - - - - - 2cd75550 by Ben Gamari at 2022-07-16T23:50:36-04:00 Loader: Implement gnu-style -l:$path syntax Gnu ld allows `-l` to be passed an absolute file path, signalled by a `:` prefix. Implement this in the GHC's loader search logic. - - - - - 5781a360 by Ben Gamari at 2022-07-16T23:50:36-04:00 Statically-link against libc++ on Windows Unfortunately on Windows we have no RPATH-like facility, making dynamic linking extremely fragile. Since we cannot assume that the user will add their GHC installation to `$PATH` (and therefore their DLL search path) we cannot assume that the loader will be able to locate our `libc++.dll`. To avoid this, we instead statically link against `libc++.a` on Windows. Fixes #21435. - - - - - 8e2e883b by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Ensure that all .ctors/.dtors sections are run It turns out that PE objects may have multiple `.ctors`/`.dtors` sections but the RTS linker had assumed that there was only one. Fix this. Fixes #21618. - - - - - fba04387 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Respect dtor/ctor priority Previously we would run constructors and destructors in arbitrary order despite explicit priorities. Fixes #21847. - - - - - 1001952f by Ben Gamari at 2022-07-16T23:50:36-04:00 testsuite: Add test for #21618 and #21847 - - - - - 6f3816af by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Fix exception unwind unregistration RtlDeleteFunctionTable expects a pointer to the .pdata section yet we passed it the .xdata section. Happily, this fixes #21354. - - - - - d9bff44c by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/MachO: Drop dead code - - - - - d161e6bc by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/MachO: Use section flags to identify initializers - - - - - fbb17110 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/MachO: Introduce finalizer support - - - - - 5b0ed8a8 by Ben Gamari at 2022-07-16T23:50:37-04:00 testsuite: Use system-cxx-std-lib instead of config.stdcxx_impl - - - - - 6c476e1a by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker/Elf: Work around GCC 6 init/fini behavior It appears that GCC 6t (at least on i386) fails to give init_array/fini_array sections the correct SHT_INIT_ARRAY/SHT_FINI_ARRAY section types, instead marking them as SHT_PROGBITS. This caused T20494 to fail on Debian. - - - - - 5f8203b8 by Ben Gamari at 2022-07-16T23:50:37-04:00 testsuite: Mark T13366Cxx as unbroken on Darwin - - - - - 1fd2f851 by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker: Fix resolution of __dso_handle on Darwin Darwin expects a leading underscore. - - - - - a2dc00f3 by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker: Clean up section kinds - - - - - aeb1a7c3 by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker: Ensure that __cxa_finalize is called on code unload - - - - - 028f081e by Ben Gamari at 2022-07-16T23:51:12-04:00 testsuite: Fix T11829 on Centos 7 It appears that Centos 7 has a more strict C++ compiler than most distributions since std::runtime_error is defined in <stdexcept> rather than <exception>. In T11829 we mistakenly imported the latter. - - - - - a10584e8 by Ben Gamari at 2022-07-17T22:30:32-04:00 hadrian: Rename documentation directories for consistency with make * Rename `docs` to `doc` * Place pdf documentation in `doc/` instead of `doc/pdfs/` Fixes #21164. - - - - - b27c5947 by Anselm Schüler at 2022-07-17T22:31:11-04:00 Fix incorrect proof of applyWhen’s properties - - - - - eb031a5b by Matthew Pickering at 2022-07-18T08:04:47-04:00 hadrian: Add multi:<pkg> and multi targets for starting a multi-repl This patch adds support to hadrian for starting a multi-repl containing all the packages which stage0 can build. In particular, there is the new user-facing command: ``` ./hadrian/ghci-multi ``` which when executed will start a multi-repl containing the `ghc` package and all it's dependencies. This is implemented by two new hadrian targets: ``` ./hadrian/build multi:<pkg> ``` Construct the arguments for a multi-repl session where the top-level package is <pkg>. For example, `./hadrian/ghci-multi` is implemented using `multi:ghc` target. There is also the `multi` command which constructs a repl for everything in stage0 which we can build. - - - - - 19e7cac9 by Eric Lindblad at 2022-07-18T08:05:27-04:00 changelog typo - - - - - af6731a4 by Eric Lindblad at 2022-07-18T08:05:27-04:00 typos - - - - - 415468fe by Simon Peyton Jones at 2022-07-18T16:36:54-04:00 Refactor SpecConstr to use treat bindings uniformly This patch, provoked by #21457, simplifies SpecConstr by treating top-level and nested bindings uniformly (see the new scBind). * Eliminates the mysterious scTopBindEnv * Refactors scBind to handle top-level and nested definitions uniformly. * But, for now at least, continues the status quo of not doing SpecConstr for top-level non-recursive bindings. (In contrast we do specialise nested non-recursive bindings, although the original paper did not; see Note [Local let bindings].) I tried the effect of specialising top-level non-recursive bindings (which is now dead easy to switch on, unlike before) but found some regressions, so I backed off. See !8135. It's a pure refactoring. I think it'll do a better job in a few cases, but there is no regression test. - - - - - d4d3fe6e by Andreas Klebinger at 2022-07-18T16:37:29-04:00 Rule matching: Don't compute the FVs if we don't look at them. - - - - - 5f907371 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 White space only in FamInstEnv - - - - - ae3b3b62 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Make transferPolyIdInfo work for CPR I don't know why this hasn't bitten us before, but it was plain wrong. - - - - - 9bdfdd98 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Inline mapAccumLM This function is called in inner loops in the compiler, and it's overloaded and higher order. Best just to inline it. This popped up when I was looking at something else. I think perhaps GHC is delicately balanced on the cusp of inlining this automatically. - - - - - d0b806ff by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Make SetLevels honour floatConsts This fix, in the definition of profitableFloat, is just for consistency. `floatConsts` should do what it says! I don't think it'll affect anything much, though. - - - - - d1c25a48 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Refactor wantToUnboxArg a bit * Rename GHC.Core.Opt.WorkWrap.Utils.wantToUnboxArg to canUnboxArg and similarly wantToUnboxResult to canUnboxResult. * Add GHC.Core.Opt.DmdAnal.wantToUnboxArg as a wrapper for the (new) GHC.Core.Opt.WorkWrap.Utils.canUnboxArg, avoiding some yukky duplication. I decided it was clearer to give it a new data type for its return type, because I nedeed the FD_RecBox case which was not otherwise readiliy expressible. * Add dcpc_args to WorkWrap.Utils.DataConPatContext for the payload * Get rid of the Unlift constructor of UnboxingDecision, eliminate two panics, and two arguments to canUnboxArg (new name). Much nicer now. - - - - - 6d8a715e by Teo Camarasu at 2022-07-18T16:38:44-04:00 Allow running memInventory when the concurrent nonmoving gc is enabled If the nonmoving gc is enabled and we are using a threaded RTS, we now try to grab the collector mutex to avoid memInventory and the collection racing. Before memInventory was disabled. - - - - - aa75bbde by Ben Gamari at 2022-07-18T16:39:20-04:00 gitignore: don't ignore all aclocal.m4 files While GHC's own aclocal.m4 is generated by the aclocal tool, other packages' aclocal.m4 are committed in the repository. Previously `.gitignore` included an entry which covered *any* file named `aclocal.m4`, which lead to quite some confusion (e.g. see #21740). Fix this by modifying GHC's `.gitignore` to only cover GHC's own `aclocal.m4`. - - - - - 4b98c5ce by Boris Lykah at 2022-07-19T02:34:12-04:00 Add mapAccumM, forAccumM to Data.Traversable Approved by Core Libraries Committee in https://github.com/haskell/core-libraries-committee/issues/65#issuecomment-1186275433 - - - - - bd92182c by Ben Gamari at 2022-07-19T02:34:47-04:00 configure: Use AC_PATH_TOOL to detect tools Previously we used AC_PATH_PROG which, as noted by #21601, does not look for tools with a target prefix, breaking cross-compilation. Fixes #21601. - - - - - e8c07aa9 by Matthew Pickering at 2022-07-19T10:07:53-04:00 driver: Fix implementation of -S We were failing to stop before running the assembler so the object file was also created. Fixes #21869 - - - - - e2f0094c by Ben Gamari at 2022-07-19T10:08:28-04:00 rts/ProfHeap: Ensure new Censuses are zeroed When growing the Census array ProfHeap previously neglected to zero the new part of the array. Consequently `freeEra` would attempt to free random words that often looked suspiciously like pointers. Fixes #21880. - - - - - 81d65f7f by sheaf at 2022-07-21T15:37:22+02:00 Make withDict opaque to the specialiser As pointed out in #21575, it is not sufficient to set withDict to inline after the typeclass specialiser, because we might inline withDict in one module and then import it in another, and we run into the same problem. This means we could still end up with incorrect runtime results because the typeclass specialiser would assume that distinct typeclass evidence terms at the same type are equal, when this is not necessarily the case when using withDict. Instead, this patch introduces a new magicId, 'nospec', which is only inlined in CorePrep. We make use of it in the definition of withDict to ensure that the typeclass specialiser does not common up distinct typeclass evidence terms. Fixes #21575 - - - - - 9a3e1f31 by Dominik Peteler at 2022-07-22T08:18:40-04:00 Refactored Simplify pass * Removed references to driver from GHC.Core.LateCC, GHC.Core.Simplify namespace and GHC.Core.Opt.Stats. Also removed services from configuration records. * Renamed GHC.Core.Opt.Simplify to GHC.Core.Opt.Simplify.Iteration. * Inlined `simplifyPgm` and renamed `simplifyPgmIO` to `simplifyPgm` and moved the Simplify driver to GHC.Core.Opt.Simplify. * Moved `SimplMode` and `FloatEnable` to GHC.Core.Opt.Simplify.Env. * Added a configuration record `TopEnvConfig` for the `SimplTopEnv` environment in GHC.Core.Opt.Simplify.Monad. * Added `SimplifyOpts` and `SimplifyExprOpts`. Provide initialization functions for those in a new module GHC.Driver.Config.Core.Opt.Simplify. Also added initialization functions for `SimplMode` to that module. * Moved `CoreToDo` and friends to a new module GHC.Core.Pipeline.Types and the counting types and functions (`SimplCount` and `Tick`) to new module GHC.Core.Opt.Stats. * Added getter functions for the fields of `SimplMode`. The pedantic bottoms option and the platform are retrieved from the ArityOpts and RuleOpts and the getter functions allow us to retrieve values from `SpecEnv` without the knowledge where the data is stored exactly. * Moved the coercion optimization options from the top environment to `SimplMode`. This way the values left in the top environment are those dealing with monadic functionality, namely logging, IO related stuff and counting. Added a note "The environments of the Simplify pass". * Removed `CoreToDo` from GHC.Core.Lint and GHC.CoreToStg.Prep and got rid of `CoreDoSimplify`. Pass `SimplifyOpts` in the `CoreToDo` type instead. * Prep work before removing `InteractiveContext` from `HscEnv`. - - - - - 2c5991cc by Simon Peyton Jones at 2022-07-22T08:18:41-04:00 Make the specialiser deal better with specialised methods This patch fixes #21848, by being more careful to update unfoldings in the type-class specialiser. See the new Note [Update unfolding after specialisation] Now that we are being so much more careful about unfoldings, it turned out that I could dispense with se_interesting, and all its tricky corners. Hooray. This fixes #21368. - - - - - ae166635 by Ben Gamari at 2022-07-22T08:18:41-04:00 ghc-boot: Clean up UTF-8 codecs In preparation for moving the UTF-8 codecs into `base`: * Move them to GHC.Utils.Encoding.UTF8 * Make names more consistent * Add some Haddocks - - - - - e8ac91db by Ben Gamari at 2022-07-22T08:18:41-04:00 base: Introduce GHC.Encoding.UTF8 Here we copy a subset of the UTF-8 implementation living in `ghc-boot` into `base`, with the intent of dropping the former in the future. For this reason, the `ghc-boot` copy is now CPP-guarded on `MIN_VERSION_base(4,18,0)`. Naturally, we can't copy *all* of the functions defined by `ghc-boot` as some depend upon `bytestring`; we rather just copy those which only depend upon `base` and `ghc-prim`. Further consolidation? ---------------------- Currently GHC ships with at least five UTF-8 implementations: * the implementation used by GHC in `ghc-boot:GHC.Utils.Encoding`; this can be used at a number of types including `Addr#`, `ByteArray#`, `ForeignPtr`, `Ptr`, `ShortByteString`, and `ByteString`. Most of this can be removed in GHC 9.6+2, when the copies in `base` will become available to `ghc-boot`. * the copy of the `ghc-boot` definition now exported by `base:GHC.Encoding.UTF8`. This can be used at `Addr#`, `Ptr`, `ByteArray#`, and `ForeignPtr` * the decoder used by `unpackCStringUtf8#` in `ghc-prim:GHC.CString`; this is specialised at `Addr#`. * the codec used by the IO subsystem in `base:GHC.IO.Encoding.UTF8`; this is specialised at `Addr#` but, unlike the above, supports recovery in the presence of partial codepoints (since in IO contexts codepoints may be broken across buffers) * the implementation provided by the `text` library This does seem a tad silly. On the other hand, these implementations *do* materially differ from one another (e.g. in the types they support, the detail in errors they can report, and the ability to recover from partial codepoints). Consequently, it's quite unclear that further consolidate would be worthwhile. - - - - - f9ad8025 by Ben Gamari at 2022-07-22T08:18:41-04:00 Add a Note summarising GHC's UTF-8 implementations GHC has a somewhat dizzying array of UTF-8 implementations. This note describes why this is the case. - - - - - 72dfad3d by Ben Gamari at 2022-07-22T08:18:42-04:00 upload_ghc_libs: Fix path to documentation The documentation was moved in a10584e8df9b346cecf700b23187044742ce0b35 but this one occurrence was note updated. Finally closes #21164. - - - - - a8b150e7 by sheaf at 2022-07-22T08:18:44-04:00 Add test for #21871 This adds a test for #21871, which was fixed by the No Skolem Info rework (MR !7105). Fixes #21871 - - - - - 6379f942 by sheaf at 2022-07-22T08:18:46-04:00 Add test for #21360 The way record updates are typechecked/desugared changed in MR !7981. Because we desugar in the typechecker to a simple case expression, the pattern match checker becomes able to spot the long-distance information and avoid emitting an incorrect pattern match warning. Fixes #21360 - - - - - ce0cd12c by sheaf at 2022-07-22T08:18:47-04:00 Hadrian: don't try to build "unix" on Windows - - - - - dc27e15a by Simon Peyton Jones at 2022-07-25T09:42:01-04:00 Implement DeepSubsumption This MR adds the language extension -XDeepSubsumption, implementing GHC proposal #511. This change mitigates the impact of GHC proposal The changes are highly localised, by design. See Note [Deep subsumption] in GHC.Tc.Utils.Unify. The main changes are: * Add -XDeepSubsumption, which is on by default in Haskell98 and Haskell2010, but off in Haskell2021. -XDeepSubsumption largely restores the behaviour before the "simple subsumption" change. -XDeepSubsumpition has a similar flavour as -XNoMonoLocalBinds: it makes type inference more complicated and less predictable, but it may be convenient in practice. * The main changes are in: * GHC.Tc.Utils.Unify.tcSubType, which does deep susumption and eta-expanansion * GHC.Tc.Utils.Unify.tcSkolemiseET, which does deep skolemisation * In GHC.Tc.Gen.App.tcApp we call tcSubTypeNC to match the result type. Without deep subsumption, unifyExpectedType would be sufficent. See Note [Deep subsumption] in GHC.Tc.Utils.Unify. * There are no changes to Quick Look at all. * The type of `withDict` becomes ambiguous; so add -XAllowAmbiguousTypes to GHC.Magic.Dict * I fixed a small but egregious bug in GHC.Core.FVs.varTypeTyCoFVs, where we'd forgotten to take the free vars of the multiplicity of an Id. * I also had to fix tcSplitNestedSigmaTys When I did the shallow-subsumption patch commit 2b792facab46f7cdd09d12e79499f4e0dcd4293f Date: Sun Feb 2 18:23:11 2020 +0000 Simple subsumption I changed tcSplitNestedSigmaTys to not look through function arrows any more. But that was actually an un-forced change. This function is used only in * Improving error messages in GHC.Tc.Gen.Head.addFunResCtxt * Validity checking for default methods: GHC.Tc.TyCl.checkValidClass * A couple of calls in the GHCi debugger: GHC.Runtime.Heap.Inspect All to do with validity checking and error messages. Acutally its fine to look under function arrows here, and quite useful a test DeepSubsumption05 (a test motivated by a build failure in the `lens` package) shows. The fix is easy. I added Note [tcSplitNestedSigmaTys]. - - - - - e31ead39 by Matthew Pickering at 2022-07-25T09:42:01-04:00 Add tests that -XHaskell98 and -XHaskell2010 enable DeepSubsumption - - - - - 67189985 by Matthew Pickering at 2022-07-25T09:42:01-04:00 Add DeepSubsumption08 - - - - - 5e93a952 by Simon Peyton Jones at 2022-07-25T09:42:01-04:00 Fix the interaction of operator sections and deep subsumption Fixes DeepSubsumption08 - - - - - 918620d9 by Zubin Duggal at 2022-07-25T09:42:01-04:00 Add DeepSubsumption09 - - - - - 2a773259 by Gabriella Gonzalez at 2022-07-25T09:42:40-04:00 Default implementation for mempty/(<>) Approved by: https://github.com/haskell/core-libraries-committee/issues/61 This adds a default implementation for `mempty` and `(<>)` along with a matching `MINIMAL` pragma so that `Semigroup` and `Monoid` instances can be defined in terms of `sconcat` / `mconcat`. The description for each class has also been updated to include the equivalent set of laws for the `sconcat`-only / `mconcat`-only instances. - - - - - 73836fc8 by Bryan Richter at 2022-07-25T09:43:16-04:00 ci: Disable (broken) perf-nofib See #21859 - - - - - c24ca5c3 by sheaf at 2022-07-25T09:43:58-04:00 Docs: clarify ConstraintKinds infelicity GHC doesn't consistently require the ConstraintKinds extension to be enabled, as it allows programs such as type families returning a constraint without this extension. MR !7784 fixes this infelicity, but breaking user programs was deemed to not be worth it, so we document it instead. Fixes #21061. - - - - - 5f2fbd5e by Simon Peyton Jones at 2022-07-25T09:44:34-04:00 More improvements to worker/wrapper This patch fixes #21888, and simplifies finaliseArgBoxities by eliminating the (recently introduced) data type FinalDecision. A delicate interaction meant that this patch commit d1c25a48154236861a413e058ea38d1b8320273f Date: Tue Jul 12 16:33:46 2022 +0100 Refactor wantToUnboxArg a bit make worker/wrapper go into an infinite loop. This patch fixes it by narrowing the handling of case (B) of Note [Boxity for bottoming functions], to deal only the arguemnts that are type variables. Only then do we drop the trimBoxity call, which is what caused the bug. I also * Added documentation of case (B), which was previously completely un-mentioned. And a regression test, T21888a, to test it. * Made unboxDeeplyDmd stop at lazy demands. It's rare anyway for a bottoming function to have a lazy argument (mainly when the data type is recursive and then we don't want to unbox deeply). Plus there is Note [No lazy, Unboxed demands in demand signature] * Refactored the Case equation for dmdAnal a bit, to do less redundant pattern matching. - - - - - b77d95f8 by Simon Peyton Jones at 2022-07-25T09:45:09-04:00 Fix a small buglet in tryEtaReduce Gergo points out (#21801) that GHC.Core.Opt.Arity.tryEtaReduce was making an ill-formed cast. It didn't matter, because the subsequent guard discarded it; but still worth fixing. Spurious warnings are distracting. - - - - - 3bbde957 by Zubin Duggal at 2022-07-25T09:45:45-04:00 Fix #21889, GHCi misbehaves with Ctrl-C on Windows On Windows, we create multiple levels of wrappers for GHCi which ultimately execute ghc --interactive. In order to handle console events properly, each of these wrappers must call FreeConsole() in order to hand off event processing to the child process. See #14150. In addition to this, FreeConsole must only be called from interactive processes (#13411). This commit makes two changes to fix this situation: 1. The hadrian wrappers generated using `hadrian/bindist/cwrappers/version-wrapper.c` call `FreeConsole` if the CPP flag INTERACTIVE_PROCESS is set, which is set when we are generating a wrapper for GHCi. 2. The GHCi wrapper in `driver/ghci/` calls the `ghc-$VER.exe` executable which is not wrapped rather than calling `ghc.exe` is is wrapped on windows (and usually non-interactive, so can't call `FreeConsole`: Before: ghci-$VER.exe calls ghci.exe which calls ghc.exe which calls ghc-$VER.exe After: ghci-$VER.exe calls ghci.exe which calls ghc-$VER.exe - - - - - 79f1b021 by Simon Jakobi at 2022-07-25T09:46:21-04:00 docs: Fix documentation of \cases Fixes #21902. - - - - - e4bf9592 by sternenseemann at 2022-07-25T09:47:01-04:00 ghc-cabal: allow Cabal 3.8 to unbreak make build When bootstrapping GHC 9.4.*, the build will fail when configuring ghc-cabal as part of the make based build system due to this upper bound, as Cabal has been updated to a 3.8 release. Reference #21914, see especially https://gitlab.haskell.org/ghc/ghc/-/issues/21914#note_444699 - - - - - 726d938e by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Fix isEvaldUnfolding and isValueUnfolding This fixes (1) in #21831. Easy, obviously correct. - - - - - 5d26c321 by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Switch off eta-expansion in rules and unfoldings I think this change will make little difference except to reduce clutter. But that's it -- if it causes problems we can switch it on again. - - - - - d4fe2f4e by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Teach SpecConstr about typeDeterminesValue This patch addresses #21831, point 2. See Note [generaliseDictPats] in SpecConstr I took the opportunity to refactor the construction of specialisation rules a bit, so that the rule name says what type we are specialising at. Surprisingly, there's a 20% decrease in compile time for test perf/compiler/T18223. I took a look at it, and the code size seems the same throughout. I did a quick ticky profile which seemed to show a bit less substitution going on. Hmm. Maybe it's the "don't do eta-expansion in stable unfoldings" patch, which is part of the same MR as this patch. Anyway, since it's a move in the right direction, I didn't think it was worth looking into further. Metric Decrease: T18223 - - - - - 65f7838a by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Add a 'notes' file in testsuite/tests/perf/compiler This file is just a place to accumlate notes about particular benchmarks, so that I don't keep re-inventing the wheel. - - - - - 61faff40 by Simon Peyton Jones at 2022-07-25T14:38:50-04:00 Get the in-scope set right in FamInstEnv.injectiveBranches There was an assert error, as Gergo pointed out in #21896. I fixed this by adding an InScopeSet argument to tcUnifyTyWithTFs. And also to GHC.Core.Unify.niFixTCvSubst. I also took the opportunity to get a couple more InScopeSets right, and to change some substTyUnchecked into substTy. This MR touches a lot of other files, but only because I also took the opportunity to introduce mkInScopeSetList, and use it. - - - - - 4a7256a7 by Cheng Shao at 2022-07-25T20:41:55+00:00 Add location to cc phase - - - - - 96811ba4 by Cheng Shao at 2022-07-25T20:41:55+00:00 Avoid as pipeline when compiling c - - - - - 2869b66d by Cheng Shao at 2022-07-25T20:42:20+00:00 testsuite: Skip test cases involving -S when testing unregisterised GHC We no longer generate .s files anyway. Metric Decrease: MultiLayerModules T10421 T13035 T13701 T14697 T16875 T18140 T18304 T18923 T9198 - - - - - 82a0991a by Ben Gamari at 2022-07-25T23:32:05-04:00 testsuite: introduce nonmoving_thread_sanity way (cherry picked from commit 19f8fce3659de3d72046bea9c61d1a82904bc4ae) - - - - - 4b087973 by Ben Gamari at 2022-07-25T23:32:06-04:00 rts/nonmoving: Track segment state It can often be useful during debugging to be able to determine the state of a nonmoving segment. Introduce some state, enabled by DEBUG, to track this. (cherry picked from commit 40e797ef591ae3122ccc98ab0cc3cfcf9d17bd7f) - - - - - 54a5c32d by Ben Gamari at 2022-07-25T23:32:06-04:00 rts/nonmoving: Don't scavenge objects which weren't evacuated This fixes a rather subtle bug in the logic responsible for scavenging objects evacuated to the non-moving generation. In particular, objects can be allocated into the non-moving generation by two ways: a. evacuation out of from-space by the garbage collector b. direct allocation by the mutator Like all evacuation, objects moved by (a) must be scavenged, since they may contain references to other objects located in from-space. To accomplish this we have the following scheme: * each nonmoving segment's block descriptor has a scan pointer which points to the first object which has yet to be scavenged * the GC tracks a set of "todo" segments which have pending scavenging work * to scavenge a segment, we scavenge each of the unmarked blocks between the scan pointer and segment's `next_free` pointer. We skip marked blocks since we know the allocator wouldn't have allocated into marked blocks (since they contain presumably live data). We can stop at `next_free` since, by definition, the GC could not have evacuated any objects to blocks above `next_free` (otherwise `next_free wouldn't be the first free block). However, this neglected to consider objects allocated by path (b). In short, the problem is that objects directly allocated by the mutator may become unreachable (but not swept, since the containing segment is not yet full), at which point they may contain references to swept objects. Specifically, we observed this in #21885 in the following way: 1. the mutator (specifically in #21885, a `lockCAF`) allocates an object (specifically a blackhole, which here we will call `blkh`; see Note [Static objects under the nonmoving collector] for the reason why) on the non-moving heap. The bitmap of the allocated block remains 0 (since allocation doesn't affect the bitmap) and the containing segment's (which we will call `blkh_seg`) `next_free` is advanced. 2. We enter the blackhole, evaluating the blackhole to produce a result (specificaly a cons cell) in the nursery 3. The blackhole gets updated into an indirection pointing to the cons cell; it is pushed to the generational remembered set 4. we perform a GC, the cons cell is evacuated into the nonmoving heap (into segment `cons_seg`) 5. the cons cell is marked 6. the GC concludes 7. the CAF and blackhole become unreachable 8. `cons_seg` is filled 9. we start another GC; the cons cell is swept 10. we start a new GC 11. something is evacuated into `blkh_seg`, adding it to the "todo" list 12. we attempt to scavenge `blkh_seg` (namely, all unmarked blocks between `scan` and `next_free`, which includes `blkh`). We attempt to evacuate `blkh`'s indirectee, which is the previously-swept cons cell. This is unsafe, since the indirectee is no longer a valid heap object. The problem here was that the scavenging logic *assumed* that (a) was the only source of allocations into the non-moving heap and therefore *all* unmarked blocks between `scan` and `next_free` were evacuated. However, due to (b) this is not true. The solution is to ensure that that the scanned region only encompasses the region of objects allocated during evacuation. We do this by updating `scan` as we push the segment to the todo-segment list to point to the block which was evacuated into. Doing this required changing the nonmoving scavenging implementation's update of the `scan` pointer to bump it *once*, instead of after scavenging each block as was done previously. This is because we may end up evacuating into the segment being scavenged as we scavenge it. This was quite tricky to discover but the result is quite simple, demonstrating yet again that global mutable state should be used exceedingly sparingly. Fixes #21885 (cherry picked from commit 0b27ea23efcb08639309293faf13fdfef03f1060) - - - - - 25c24535 by Ben Gamari at 2022-07-25T23:32:06-04:00 testsuite: Skip a few tests as in the nonmoving collector Residency monitoring under the non-moving collector is quite conservative (e.g. the reported value is larger than reality) since otherwise we would need to block on concurrent collection. Skip a few tests that are sensitive to residency. (cherry picked from commit 6880e4fbf728c04e8ce83e725bfc028fcb18cd70) - - - - - 42147534 by sternenseemann at 2022-07-26T16:26:53-04:00 hadrian: add flag disabling selftest rules which require QuickCheck The hadrian executable depends on QuickCheck for building, meaning this library (and its dependencies) will need to be built for bootstrapping GHC in the future. Building QuickCheck, however, can require TemplateHaskell. When building a statically linking GHC toolchain, TemplateHaskell can be tricky to get to work, and cross-compiling TemplateHaskell doesn't work at all without -fexternal-interpreter, so QuickCheck introduces an element of fragility to GHC's bootstrap. Since the selftest rules are the only part of hadrian that need QuickCheck, we can easily eliminate this bootstrap dependency when required by introducing a `selftest` flag guarding the rules' inclusion. Closes #8699. - - - - - 9ea29d47 by Simon Peyton Jones at 2022-07-26T16:27:28-04:00 Regression test for #21848 - - - - - ef30e215 by Matthew Pickering at 2022-07-28T13:56:59-04:00 driver: Don't create LinkNodes when -no-link is enabled Fixes #21866 - - - - - fc23b5ed by sheaf at 2022-07-28T13:57:38-04:00 Docs: fix mistaken claim about kind signatures This patch fixes #21806 by rectifying an incorrect claim about the usage of kind variables in the header of a data declaration with a standalone kind signature. It also adds some clarifications about the number of parameters expected in GADT declarations and in type family declarations. - - - - - 2df92ee1 by Matthew Pickering at 2022-08-02T05:20:01-04:00 testsuite: Correctly set withNativeCodeGen Fixes #21918 - - - - - f2912143 by Matthew Pickering at 2022-08-02T05:20:45-04:00 Fix since annotations in GHC.Stack.CloneStack Fixes #21894 - - - - - aeb8497d by Andreas Klebinger at 2022-08-02T19:26:51-04:00 Add -dsuppress-coercion-types to make coercions even smaller. Instead of `` `cast` <Co:11> :: (Some -> Really -> Large Type)`` simply print `` `cast` <Co:11> :: ... `` - - - - - 97655ad8 by sheaf at 2022-08-02T19:27:29-04:00 User's guide: fix typo in hasfield.rst Fixes #21950 - - - - - 35aef18d by Yiyun Liu at 2022-08-04T02:55:07-04:00 Remove TCvSubst and use Subst for both term and type-level subst This patch removes the TCvSubst data type and instead uses Subst as the environment for both term and type level substitution. This change is partially motivated by the existential type proposal, which will introduce types that contain expressions and therefore forces us to carry around an "IdSubstEnv" even when substituting for types. It also reduces the amount of code because "Subst" and "TCvSubst" share a lot of common operations. There isn't any noticeable impact on performance (geo. mean for ghc/alloc is around 0.0% but we have -94 loc and one less data type to worry abount). Currently, the "TCvSubst" data type for substitution on types is identical to the "Subst" data type except the former doesn't store "IdSubstEnv". Using "Subst" for type-level substitution means there will be a redundant field stored in the data type. However, in cases where the substitution starts from the expression, using "Subst" for type-level substitution saves us from having to project "Subst" into a "TCvSubst". This probably explains why the allocation is mostly even despite the redundant field. The patch deletes "TCvSubst" and moves "Subst" and its relevant functions from "GHC.Core.Subst" into "GHC.Core.TyCo.Subst". Substitution on expressions is still defined in "GHC.Core.Subst" so we don't have to expose the definition of "Expr" in the hs-boot file that "GHC.Core.TyCo.Subst" must import to refer to "IdSubstEnv" (whose codomain is "CoreExpr"). Most functions named fooTCvSubst are renamed into fooSubst with a few exceptions (e.g. "isEmptyTCvSubst" is a distinct function from "isEmptySubst"; the former ignores the emptiness of "IdSubstEnv"). These exceptions mainly exist for performance reasons and will go away when "Expr" and "Type" are mutually recursively defined (we won't be able to take those shortcuts if we can't make the assumption that expressions don't appear in types). - - - - - b99819bd by Krzysztof Gogolewski at 2022-08-04T02:55:43-04:00 Fix TH + defer-type-errors interaction (#21920) Previously, we had to disable defer-type-errors in splices because of #7276. But this fix is no longer necessary, the test T7276 no longer segfaults and is now correctly deferred. - - - - - fb529cae by Andreas Klebinger at 2022-08-04T13:57:25-04:00 Add a note about about W/W for unlifting strict arguments This fixes #21236. - - - - - fffc75a9 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force safeInferred to avoid retaining extra copy of DynFlags This will only have a (very) modest impact on memory but we don't want to retain old copies of DynFlags hanging around so best to force this value. - - - - - 0f43837f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force name selectors to ensure no reference to Ids enter the NameCache I observed some unforced thunks in the NameCache which were retaining a whole Id, which ends up retaining a Type.. which ends up retaining old copies of HscEnv containing stale HomeModInfo. - - - - - 0b1f5fd1 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Fix leaks in --make mode when there are module loops This patch fixes quite a tricky leak where we would end up retaining stale ModDetails due to rehydrating modules against non-finalised interfaces. == Loops with multiple boot files It is possible for a module graph to have a loop (SCC, when ignoring boot files) which requires multiple boot files to break. In this case we must perform the necessary hydration steps before and after compiling modules which have boot files which are described above for corectness but also perform an additional hydration step at the end of the SCC to remove space leaks. Consider the following example: ┌───────┐ ┌───────┐ │ │ │ │ │ A │ │ B │ │ │ │ │ └─────┬─┘ └───┬───┘ │ │ ┌────▼─────────▼──┐ │ │ │ C │ └────┬─────────┬──┘ │ │ ┌────▼──┐ ┌───▼───┐ │ │ │ │ │ A-boot│ │ B-boot│ │ │ │ │ └───────┘ └───────┘ A, B and C live together in a SCC. Say we compile the modules in order A-boot, B-boot, C, A, B then when we compile A we will perform the hydration steps (because A has a boot file). Therefore C will be hydrated relative to A, and the ModDetails for A will reference C/A. Then when B is compiled C will be rehydrated again, and so B will reference C/A,B, its interface will be hydrated relative to both A and B. Now there is a space leak because say C is a very big module, there are now two different copies of ModDetails kept alive by modules A and B. The way to avoid this space leak is to rehydrate an entire SCC together at the end of compilation so that all the ModDetails point to interfaces for .hs files. In this example, when we hydrate A, B and C together then both A and B will refer to C/A,B. See #21900 for some more discussion. ------------------------------------------------------- In addition to this simple case, there is also the potential for a leak during parallel upsweep which is also fixed by this patch. Transcibed is Note [ModuleNameSet, efficiency and space leaks] Note [ModuleNameSet, efficiency and space leaks] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ During unsweep the results of compiling modules are placed into a MVar, to find the environment the module needs to compile itself in the MVar is consulted and the HomeUnitGraph is set accordingly. The reason we do this is that precisely tracking module dependencies and recreating the HUG from scratch each time is very expensive. In serial mode (-j1), this all works out fine because a module can only be compiled after its dependencies have finished compiling and not interleaved with compiling module loops. Therefore when we create the finalised or no loop interfaces, the HUG only contains finalised interfaces. In parallel mode, we have to be more careful because the HUG variable can contain non-finalised interfaces which have been started by another thread. In order to avoid a space leak where a finalised interface is compiled against a HPT which contains a non-finalised interface we have to restrict the HUG to only the visible modules. The visible modules is recording in the ModuleNameSet, this is propagated upwards whilst compiling and explains which transitive modules are visible from a certain point. This set is then used to restrict the HUG before the module is compiled to only the visible modules and thus avoiding this tricky space leak. Efficiency of the ModuleNameSet is of utmost importance because a union occurs for each edge in the module graph. Therefore the set is represented directly as an IntSet which provides suitable performance, even using a UniqSet (which is backed by an IntMap) is too slow. The crucial test of performance here is the time taken to a do a no-op build in --make mode. See test "jspace" for an example which used to trigger this problem. Fixes #21900 - - - - - 1d94a59f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Store interfaces in ModIfaceCache more directly I realised hydration was completely irrelavant for this cache because the ModDetails are pruned from the result. So now it simplifies things a lot to just store the ModIface and Linkable, which we can put into the cache straight away rather than wait for the final version of a HomeModInfo to appear. - - - - - 6c7cd50f by Cheng Shao at 2022-08-04T23:01:45-04:00 cmm: Remove unused ReadOnlyData16 We don't actually emit rodata16 sections anywhere. - - - - - 16333ad7 by Andreas Klebinger at 2022-08-04T23:02:20-04:00 findExternalRules: Don't needlessly traverse the list of rules. - - - - - 52c15674 by Krzysztof Gogolewski at 2022-08-05T12:47:05-04:00 Remove backported items from 9.6 release notes They have been backported to 9.4 in commits 5423d84bd9a28f, 13c81cb6be95c5, 67ccbd6b2d4b9b. - - - - - 78d232f5 by Matthew Pickering at 2022-08-05T12:47:40-04:00 ci: Fix pages job The job has been failing because we don't bundle haddock docs anymore in the docs dist created by hadrian. Fixes #21789 - - - - - 037bc9c9 by Ben Gamari at 2022-08-05T22:00:29-04:00 codeGen/X86: Don't clobber switch variable in switch generation Previously ce8745952f99174ad9d3bdc7697fd086b47cdfb5 assumed that it was safe to clobber the switch variable when generating code for a jump table since we were at the end of a block. However, this assumption is wrong; the register could be live in the jump target. Fixes #21968. - - - - - 50c8e1c5 by Matthew Pickering at 2022-08-05T22:01:04-04:00 Fix equality operator in jspace test - - - - - e9c77a22 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Improve BUILD_PAP comments - - - - - 41234147 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Make dropTail comment a haddock comment - - - - - ff11d579 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Add one more sanity check in stg_restore_cccs - - - - - 1f6c56ae by Andreas Klebinger at 2022-08-06T06:13:17-04:00 StgToCmm: Fix isSimpleScrut when profiling is enabled. When profiling is enabled we must enter functions that might represent thunks in order for their sccs to show up in the profile. We might allocate even if the function is already evaluated in this case. So we can't consider any potential function thunk to be a simple scrut when profiling. Not doing so caused profiled binaries to segfault. - - - - - fab0ee93 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Change `-fprof-late` to insert cost centres after unfolding creation. The former behaviour of adding cost centres after optimization but before unfoldings are created is not available via the flag `prof-late-inline` instead. I also reduced the overhead of -fprof-late* by pushing the cost centres into lambdas. This means the cost centres will only account for execution of functions and not their partial application. Further I made LATE_CC cost centres it's own CC flavour so they now won't clash with user defined ones if a user uses the same string for a custom scc. LateCC: Don't put cost centres inside constructor workers. With -fprof-late they are rarely useful as the worker is usually inlined. Even if the worker is not inlined or we use -fprof-late-linline they are generally not helpful but bloat compile and run time significantly. So we just don't add sccs inside constructor workers. ------------------------- Metric Decrease: T13701 ------------------------- - - - - - f8bec4e3 by Ben Gamari at 2022-08-06T06:13:53-04:00 gitlab-ci: Fix hadrian bootstrapping of release pipelines Previously we would attempt to test hadrian bootstrapping in the `validate` build flavour. However, `ci.sh` refuses to run validation builds during release pipelines, resulting in job failures. Fix this by testing bootstrapping in the `release` flavour during release pipelines. We also attempted to record perf notes for these builds, which is redundant work and undesirable now since we no longer build in a consistent flavour. - - - - - c0348865 by Ben Gamari at 2022-08-06T11:45:17-04:00 compiler: Eliminate two uses of foldr in favor of foldl' These two uses constructed maps, which is a case where foldl' is generally more efficient since we avoid constructing an intermediate O(n)-depth stack. - - - - - d2e4e123 by Ben Gamari at 2022-08-06T11:45:17-04:00 rts: Fix code style - - - - - 57f530d3 by Ben Gamari at 2022-08-06T11:45:17-04:00 genprimopcode: Drop ArrayArray# references As ArrayArray# no longer exists - - - - - 7267cd52 by Ben Gamari at 2022-08-06T11:45:17-04:00 base: Organize Haddocks in GHC.Conc.Sync - - - - - aa818a9f by Ben Gamari at 2022-08-06T11:48:50-04:00 Add primop to list threads A user came to #ghc yesterday wondering how best to check whether they were leaking threads. We ended up using the eventlog but it seems to me like it would be generally useful if Haskell programs could query their own threads. - - - - - 6d1700b6 by Ben Gamari at 2022-08-06T11:51:35-04:00 rts: Move thread labels into TSO This eliminates the thread label HashTable and instead tracks this information in the TSO, allowing us to use proper StgArrBytes arrays for backing the label and greatly simplifying management of object lifetimes when we expose them to the user with the coming `threadLabel#` primop. - - - - - 1472044b by Ben Gamari at 2022-08-06T11:54:52-04:00 Add a primop to query the label of a thread - - - - - 43f2b271 by Ben Gamari at 2022-08-06T11:55:14-04:00 base: Share finalization thread label For efficiency's sake we float the thread label assigned to the finalization thread to the top-level, ensuring that we only need to encode the label once. - - - - - 1d63b4fb by Ben Gamari at 2022-08-06T11:57:11-04:00 users-guide: Add release notes entry for thread introspection support - - - - - 09bca1de by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix binary distribution install attributes Previously we would use plain `cp` to install various parts of the binary distribution. However, `cp`'s behavior w.r.t. file attributes is quite unclear; for this reason it is much better to rather use `install`. Fixes #21965. - - - - - 2b8ea16d by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix installation of system-cxx-std-lib package conf - - - - - 7b514848 by Ben Gamari at 2022-08-07T01:20:10-04:00 gitlab-ci: Bump Docker images To give the ARMv7 job access to lld, fixing #21875. - - - - - afa584a3 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Don't use mk/config.mk.in Ultimately we want to drop mk/config.mk so here I extract the bits needed by the Hadrian bindist installation logic into a Hadrian-specific file. While doing this I fixed binary distribution installation, #21901. - - - - - b9bb45d7 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Fix naming of cross-compiler wrappers - - - - - 78d04cfa by Ben Gamari at 2022-08-07T11:44:58-04:00 hadrian: Extend xattr Darwin hack to cover /lib As noted in #21506, it is now necessary to remove extended attributes from `/lib` as well as `/bin` to avoid SIP issues on Darwin. Fixes #21506. - - - - - 20457d77 by Andreas Klebinger at 2022-08-08T14:42:26+02:00 NCG(x86): Compile add+shift as lea if possible. - - - - - 742292e4 by Andreas Klebinger at 2022-08-08T16:46:37-04:00 dataToTag#: Skip runtime tag check if argument is infered tagged This addresses one part of #21710. - - - - - 1504a93e by Cheng Shao at 2022-08-08T16:47:14-04:00 rts: remove redundant stg_traceCcszh This out-of-line primop has no Haskell wrapper and hasn't been used anywhere in the tree. Furthermore, the code gets in the way of !7632, so it should be garbage collected. - - - - - a52de3cb by Andreas Klebinger at 2022-08-08T16:47:50-04:00 Document a divergence from the report in parsing function lhss. GHC is happy to parse `(f) x y = x + y` when it should be a parse error based on the Haskell report. Seems harmless enough so we won't fix it but it's documented now. Fixes #19788 - - - - - 5765e133 by Ben Gamari at 2022-08-08T16:48:25-04:00 gitlab-ci: Add release job for aarch64/debian 11 - - - - - 5b26f324 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Introduce validation job for aarch64 cross-compilation Begins to address #11958. - - - - - e866625c by Ben Gamari at 2022-08-08T19:39:20-04:00 Bump process submodule - - - - - ae707762 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - 50912d68 by Ben Gamari at 2022-08-08T19:39:57-04:00 rts: Ensure that Array# card arrays are initialized In #19143 I noticed that newArray# failed to initialize the card table of newly-allocated arrays. However, embarrassingly, I then only fixed the issue in newArrayArray# and, in so doing, introduced the potential for an integer underflow on zero-length arrays (#21962). Here I fix the issue in newArray#, this time ensuring that we do not underflow in pathological cases. Fixes #19143. - - - - - e5ceff56 by Ben Gamari at 2022-08-08T19:39:57-04:00 testsuite: Add test for #21962 - - - - - c1c08bd8 by Ben Gamari at 2022-08-09T02:31:14-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 1c582f44 by Ben Gamari at 2022-08-09T02:31:14-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 681aa076 by Ben Gamari at 2022-08-09T02:31:49-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - e9dfd26a by Krzysztof Gogolewski at 2022-08-09T02:32:24-04:00 Cleanups around pretty-printing * Remove hack when printing OccNames. No longer needed since e3dcc0d5 * Remove unused `pprCmms` and `instance Outputable Instr` * Simplify `pprCLabel` (no need to pass platform) * Remove evil `Show`/`Eq` instances for `SDoc`. They were needed by ImmLit, but that can take just a String instead. * Remove instance `Outputable CLabel` - proper output of labels needs a platform, and is done by the `OutputableP` instance - - - - - 66d2e927 by Ben Gamari at 2022-08-09T13:46:48-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 5d66a0ce by Ben Gamari at 2022-08-09T13:46:48-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - ea90e61d by Ben Gamari at 2022-08-09T13:46:48-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - d71a2051 by sheaf at 2022-08-09T13:47:28-04:00 Fix size_up_alloc to account for UnliftedDatatypes The size_up_alloc function mistakenly considered any type that isn't lifted to not allocate anything, which is wrong. What we want instead is to check the type isn't boxed. This accounts for (BoxedRep Unlifted). Fixes #21939 - - - - - 76b52cf0 by Douglas Wilson at 2022-08-10T06:01:53-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. - - - - - 7589ee72 by Douglas Wilson at 2022-08-10T06:01:53-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. - - - - - dc76439d by Trevis Elser at 2022-08-10T06:02:28-04:00 Updates language extension documentation Adding a 'Status' field with a few values: - Deprecated - Experimental - InternalUseOnly - Noting if included in 'GHC2021', 'Haskell2010' or 'Haskell98' Those values are pulled from the existing descriptions or elsewhere in the documentation. While at it, include the :implied by: where appropriate, to provide more detail. Fixes #21475 - - - - - 823fe5b5 by Jens Petersen at 2022-08-10T06:03:07-04:00 hadrian RunRest: add type signature for stageNumber avoids warning seen on 9.4.1: src/Settings/Builders/RunTest.hs:264:53: warning: [-Wtype-defaults] • Defaulting the following constraints to type ‘Integer’ (Show a0) arising from a use of ‘show’ at src/Settings/Builders/RunTest.hs:264:53-84 (Num a0) arising from a use of ‘stageNumber’ at src/Settings/Builders/RunTest.hs:264:59-83 • In the second argument of ‘(++)’, namely ‘show (stageNumber (C.stage ctx))’ In the second argument of ‘($)’, namely ‘"config.stage=" ++ show (stageNumber (C.stage ctx))’ In the expression: arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | 264 | , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ compilation tested locally - - - - - f95bbdca by Sylvain Henry at 2022-08-10T09:44:46-04:00 Add support for external static plugins (#20964) This patch adds a new command-line flag: -fplugin-library=<file-path>;<unit-id>;<module>;<args> used like this: -fplugin-library=path/to/plugin.so;package-123;Plugin.Module;["Argument","List"] It allows a plugin to be loaded directly from a shared library. With this approach, GHC doesn't compile anything for the plugin and doesn't load any .hi file for the plugin and its dependencies. As such GHC doesn't need to support two environments (one for plugins, one for target code), which was the more ambitious approach tracked in #14335. Fix #20964 Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 5bc489ca by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Fix ARMv7 build It appears that the CI refactoring carried out in 5ff690b8474c74e9c968ef31e568c1ad0fe719a1 failed to carry over some critical configuration: setting the build/host/target platforms and forcing use of a non-broken linker. - - - - - 596db9a5 by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Run ARMv7 jobs when ~ARM label is used - - - - - 7cabea7c by Ben Gamari at 2022-08-10T15:37:58-04:00 hadrian: Don't attempt to install documentation if doc/ doesn't exist Previously we would attempt to install documentation even if the `doc` directory doesn't exist (e.g. due to `--docs=none`). This would result in the surprising side-effect of the entire contents of the bindist being installed in the destination documentation directory. Fix this. Fixes #21976. - - - - - 67575f20 by normalcoder at 2022-08-10T15:38:34-04:00 ncg/aarch64: Don't use x18 register on AArch64/Darwin Apple's ABI documentation [1] says: "The platforms reserve register x18. Don’t use this register." While this wasn't problematic in previous Darwin releases, macOS 13 appears to start zeroing this register periodically. See #21964. [1] https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms - - - - - 45eb4cbe by Andreas Klebinger at 2022-08-10T22:41:12-04:00 Note [Trimming auto-rules]: State that this improves compiler perf. - - - - - 5c24b1b3 by Bodigrim at 2022-08-10T22:41:50-04:00 Document that threadDelay / timeout are susceptible to overflows on 32-bit machines - - - - - ff67c79e by Alan Zimmerman at 2022-08-11T16:19:57-04:00 EPA: DotFieldOcc does not have exact print annotations For the code {-# LANGUAGE OverloadedRecordUpdate #-} operatorUpdate f = f{(+) = 1} There are no exact print annotations for the parens around the + symbol, nor does normal ppr print them. This MR fixes that. Closes #21805 Updates haddock submodule - - - - - dca43a04 by Matthew Pickering at 2022-08-11T16:20:33-04:00 Revert "gitlab-ci: Add release job for aarch64/debian 11" This reverts commit 5765e13370634979eb6a0d9f67aa9afa797bee46. The job was not tested before being merged and fails CI (https://gitlab.haskell.org/ghc/ghc/-/jobs/1139392) Ticket #22005 - - - - - ffc9116e by Eric Lindblad at 2022-08-16T09:01:26-04:00 typo - - - - - cd6f5bfd by Ben Gamari at 2022-08-16T09:02:02-04:00 CmmToLlvm: Don't aliasify builtin LLVM variables Our aliasification logic would previously turn builtin LLVM variables into aliases, which apparently confuses LLVM. This manifested in initializers failing to be emitted, resulting in many profiling failures with the LLVM backend. Fixes #22019. - - - - - dc7da356 by Bryan Richter at 2022-08-16T09:02:38-04:00 run_ci: remove monoidal-containers Fixes #21492 MonoidalMap is inlined and used to implement Variables, as before. The top-level value "jobs" is reimplemented as a regular Map, since it doesn't use the monoidal union anyway. - - - - - 64110544 by Cheng Shao at 2022-08-16T09:03:15-04:00 CmmToAsm/AArch64: correct a typo - - - - - f6a5524a by Andreas Klebinger at 2022-08-16T14:34:11-04:00 Fix #21979 - compact-share failing with -O I don't have good reason to believe the optimization level should affect if sharing works or not here. So limit the test to the normal way. - - - - - 68154a9d by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix reference to dead llvm-version substitution Fixes #22052. - - - - - 28c60d26 by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix incorrect reference to `:extension: role - - - - - 71102c8f by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Add :ghc-flag: reference - - - - - 385f420b by Ben Gamari at 2022-08-16T14:34:47-04:00 hadrian: Place manpage in docroot This relocates it from docs/ to doc/ - - - - - 84598f2e by Ben Gamari at 2022-08-16T14:34:47-04:00 Bump haddock submodule Includes merge of `main` into `ghc-head` as well as some Haddock users guide fixes. - - - - - 59ce787c by Ben Gamari at 2022-08-16T14:34:47-04:00 base: Add changelog entries from ghc-9.2 Closes #21922. - - - - - a14e6ae3 by Ben Gamari at 2022-08-16T14:34:47-04:00 relnotes: Add "included libraries" section As noted in #21988, some users rely on this. - - - - - a4212edc by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Rephrase the rewrite rule documentation Previously the wording was a tad unclear. Fix this. Closes #21114. - - - - - 3e493dfd by Peter Becich at 2022-08-17T08:43:21+01:00 Implement Response File support for HPC This is an improvement to HPC authored by Richard Wallace (https://github.com/purefn) and myself. I have received permission from him to attempt to upstream it. This improvement was originally implemented as a patch to HPC via input-output-hk/haskell.nix: https://github.com/input-output-hk/haskell.nix/pull/1464 Paraphrasing Richard, HPC currently requires all inputs as command line arguments. With large projects this can result in an argument list too long error. I have only seen this error in Nix, but I assume it can occur is a plain Unix environment. This MR adds the standard response file syntax support to HPC. For example you can now pass a file to the command line which contains the arguments. ``` hpc @response_file_1 @response_file_2 ... The contents of a Response File must have this format: COMMAND ... example: report my_library.tix --include=ModuleA --include=ModuleB ``` Updates hpc submodule Co-authored-by: Richard Wallace <rwallace at thewallacepack.net> Fixes #22050 - - - - - 436867d6 by Matthew Pickering at 2022-08-18T09:24:08-04:00 ghc-heap: Fix decoding of TSO closures An extra field was added to the TSO structure in 6d1700b6 but the decoding logic in ghc-heap was not updated for this new field. Fixes #22046 - - - - - a740a4c5 by Matthew Pickering at 2022-08-18T09:24:44-04:00 driver: Honour -x option The -x option is used to manually specify which phase a file should be started to be compiled from (even if it lacks the correct extension). I just failed to implement this when refactoring the driver. In particular Cabal calls GHC with `-E -cpp -x hs Foo.cpphs` to preprocess source files using GHC. I added a test to exercise this case. Fixes #22044 - - - - - e293029d by Simon Peyton Jones at 2022-08-18T09:25:19-04:00 Be more careful in chooseInferredQuantifiers This fixes #22065. We were failing to retain a quantifier that was mentioned in the kind of another retained quantifier. Easy to fix. - - - - - 714c936f by Bryan Richter at 2022-08-18T18:37:21-04:00 testsuite: Add test for #21583 - - - - - 989b844d by Ben Gamari at 2022-08-18T18:37:57-04:00 compiler: Drop --build-id=none hack Since 2011 the object-joining implementation has had a hack to pass `--build-id=none` to `ld` when supported, seemingly to work around a linker bug. This hack is now unnecessary and may break downstream users who expect objects to have valid build-ids. Remove it. Closes #22060. - - - - - 519c712e by Matthew Pickering at 2022-08-19T00:09:11-04:00 Make ru_fn field strict to avoid retaining Ids It's better to perform this projection from Id to Name strictly so we don't retain an old Id (hence IdInfo, hence Unfolding, hence everything etc) - - - - - 7dda04b0 by Matthew Pickering at 2022-08-19T00:09:11-04:00 Force `getOccFS bndr` to avoid retaining reference to Bndr. This is another symptom of #19619 - - - - - 4303acba by Matthew Pickering at 2022-08-19T00:09:11-04:00 Force unfoldings when they are cleaned-up in Tidy and CorePrep If these thunks are not forced then the entire unfolding for the binding is live throughout the whole of CodeGen despite the fact it should have been discarded. Fixes #22071 - - - - - 2361b3bc by Matthew Pickering at 2022-08-19T00:09:47-04:00 haddock docs: Fix links from identifiers to dependent packages When implementing the base_url changes I made the pretty bad mistake of zipping together two lists which were in different orders. The simpler thing to do is just modify `haddockDependencies` to also return the package identifier so that everything stays in sync. Fixes #22001 - - - - - 9a7e2ea1 by Matthew Pickering at 2022-08-19T00:10:23-04:00 Revert "Refactor SpecConstr to use treat bindings uniformly" This reverts commit 415468fef8a3e9181b7eca86de0e05c0cce31729. This refactoring introduced quite a severe residency regression (900MB live from 650MB live when compiling mmark), see #21993 for a reproducer and more discussion. Ticket #21993 - - - - - 9789e845 by Zachary Wood at 2022-08-19T14:17:28-04:00 tc: warn about lazy annotations on unlifted arguments (fixes #21951) - - - - - e5567289 by Andreas Klebinger at 2022-08-19T14:18:03-04:00 Fix #22048 where we failed to drop rules for -fomit-interface-pragmas. Now we also filter the local rules (again) which fixes the issue. - - - - - 51ffd009 by Swann Moreau at 2022-08-19T18:29:21-04:00 Print constraints in quotes (#21167) This patch improves the uniformity of error message formatting by printing constraints in quotes, as we do for types. Fix #21167 - - - - - ab3e0f5a by Sasha Bogicevic at 2022-08-19T18:29:57-04:00 19217 Implicitly quantify type variables in :kind command - - - - - 9939e95f by MorrowM at 2022-08-21T16:51:38-04:00 Recognize file-header pragmas in GHCi (#21507) - - - - - fb7c2d99 by Matthew Pickering at 2022-08-21T16:52:13-04:00 hadrian: Fix bootstrapping with ghc-9.4 The error was that we were trying to link together containers from boot package library (which depends template-haskell in boot package library) template-haskell from in-tree package database So the fix is to build containers in stage0 (and link against template-haskell built in stage0). Fixes #21981 - - - - - b946232c by Mario Blažević at 2022-08-22T22:06:21-04:00 Added pprType with precedence argument, as a prerequisite to fix issues #21723 and #21942. * refines the precedence levels, adding `qualPrec` and `funPrec` to better control parenthesization * `pprParendType`, `pprFunArgType`, and `instance Ppr Type` all just call `pprType` with proper precedence * `ParensT` constructor is now always printed parenthesized * adds the precedence argument to `pprTyApp` as well, as it needs to keep track and pass it down * using `>=` instead of former `>` to match the Core type printing logic * some test outputs have changed, losing extraneous parentheses - - - - - fe4ff0f7 by Mario Blažević at 2022-08-22T22:06:21-04:00 Fix and test for issue #21723 - - - - - 33968354 by Mario Blažević at 2022-08-22T22:06:21-04:00 Test for issue #21942 - - - - - c9655251 by Mario Blažević at 2022-08-22T22:06:21-04:00 Updated the changelog - - - - - 80102356 by Ben Gamari at 2022-08-22T22:06:57-04:00 hadrian: Don't duplicate binaries on installation Previously we used `install` on symbolic links, which ended up copying the target file rather than installing a symbolic link. Fixes #22062. - - - - - b929063e by M Farkas-Dyck at 2022-08-24T02:37:01-04:00 Unbreak Haddock comments in `GHC.Core.Opt.WorkWrap.Utils`. Closes #22092. - - - - - 112e4f9c by Cheng Shao at 2022-08-24T02:37:38-04:00 driver: don't actually merge objects when ar -L works - - - - - a9f0e68e by Ben Gamari at 2022-08-24T02:38:13-04:00 rts: Consistently use MiB in stats output Previously we would say `MB` even where we meant `MiB`. - - - - - a90298cc by Simon Peyton Jones at 2022-08-25T08:38:16+01:00 Fix arityType: -fpedantic-bottoms, join points, etc This MR fixes #21694, #21755. It also makes sure that #21948 and fix to #21694. * For #21694 the underlying problem was that we were calling arityType on an expression that had free join points. This is a Bad Bad Idea. See Note [No free join points in arityType]. * To make "no free join points in arityType" work out I had to avoid trying to use eta-expansion for runRW#. This entailed a few changes in the Simplifier's treatment of runRW#. See GHC.Core.Opt.Simplify.Iteration Note [No eta-expansion in runRW#] * I also made andArityType work correctly with -fpedantic-bottoms; see Note [Combining case branches: andWithTail]. * Rewrote Note [Combining case branches: optimistic one-shot-ness] * arityType previously treated join points differently to other let-bindings. This patch makes them unform; arityType analyses the RHS of all bindings to get its ArityType, and extends am_sigs. I realised that, now we have am_sigs giving the ArityType for let-bound Ids, we don't need the (pre-dating) special code in arityType for join points. But instead we need to extend the env for Rec bindings, which weren't doing before. More uniform now. See Note [arityType for let-bindings]. This meant we could get rid of ae_joins, and in fact get rid of EtaExpandArity altogether. Simpler. * And finally, it was the strange treatment of join-point Ids in arityType (involving a fake ABot type) that led to a serious bug: #21755. Fixed by this refactoring, which treats them uniformly; but without breaking #18328. In fact, the arity for recursive join bindings is pretty tricky; see the long Note [Arity for recursive join bindings] in GHC.Core.Opt.Simplify.Utils. That led to more refactoring, including deciding that an Id could have an Arity that is bigger than its JoinArity; see Note [Invariants on join points], item 2(b) in GHC.Core * Make sure that the "demand threshold" for join points in DmdAnal is no bigger than the join-arity. In GHC.Core.Opt.DmdAnal see Note [Demand signatures are computed for a threshold arity based on idArity] * I moved GHC.Core.Utils.exprIsDeadEnd into GHC.Core.Opt.Arity, where it more properly belongs. * Remove an old, redundant hack in FloatOut. The old Note was Note [Bottoming floats: eta expansion] in GHC.Core.Opt.SetLevels. Compile time improves very slightly on average: Metrics: compile_time/bytes allocated --------------------------------------------------------------------------------------- T18223(normal) ghc/alloc 725,808,720 747,839,216 +3.0% BAD T6048(optasm) ghc/alloc 105,006,104 101,599,472 -3.2% GOOD geo. mean -0.2% minimum -3.2% maximum +3.0% For some reason Windows was better T10421(normal) ghc/alloc 125,888,360 124,129,168 -1.4% GOOD T18140(normal) ghc/alloc 85,974,520 83,884,224 -2.4% GOOD T18698b(normal) ghc/alloc 236,764,568 234,077,288 -1.1% GOOD T18923(normal) ghc/alloc 75,660,528 73,994,512 -2.2% GOOD T6048(optasm) ghc/alloc 112,232,512 108,182,520 -3.6% GOOD geo. mean -0.6% I had a quick look at T18223 but it is knee deep in coercions and the size of everything looks similar before and after. I decided to accept that 3% increase in exchange for goodness elsewhere. Metric Decrease: T10421 T18140 T18698b T18923 T6048 Metric Increase: T18223 - - - - - 909edcfc by Ben Gamari at 2022-08-25T10:03:34-04:00 upload_ghc_libs: Add means of passing Hackage credentials - - - - - 28402eed by M Farkas-Dyck at 2022-08-25T10:04:17-04:00 Scrub some partiality in `CommonBlockElim`. - - - - - 54affbfa by Ben Gamari at 2022-08-25T20:05:31-04:00 hadrian: Fix whitespace Previously this region of Settings.Packages was incorrectly indented. - - - - - c4bba0f0 by Ben Gamari at 2022-08-25T20:05:31-04:00 validate: Drop --legacy flag In preparation for removal of the legacy `make`-based build system. - - - - - 822b0302 by Ben Gamari at 2022-08-25T20:05:31-04:00 gitlab-ci: Drop make build validation jobs In preparation for removal of the `make`-based build system - - - - - 6fd9b0a1 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop make build system Here we at long last remove the `make`-based build system, it having been replaced with the Shake-based Hadrian build system. Users are encouraged to refer to the documentation in `hadrian/doc` and this [1] blog post for details on using Hadrian. Closes #17527. [1] https://www.haskell.org/ghc/blog/20220805-make-to-hadrian.html - - - - - dbb004b0 by Ben Gamari at 2022-08-25T20:05:31-04:00 Remove testsuite/tests/perf/haddock/.gitignore As noted in #16802, this is no longer needed. Closes #16802. - - - - - fe9d824d by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop hc-build script This has not worked for many, many years and relied on the now-removed `make`-based build system. - - - - - 659502bc by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mkdirhier This is only used by nofib's dead `dist` target - - - - - 4a426924 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mk/{build,install,config}.mk.in - - - - - 46924b75 by Ben Gamari at 2022-08-25T20:05:31-04:00 compiler: Drop comment references to make - - - - - d387f687 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add inits1 and tails1 to Data.List.NonEmpty See https://github.com/haskell/core-libraries-committee/issues/67 - - - - - 8603c921 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add since annotations and changelog entries - - - - - 6b47aa1c by Krzysztof Gogolewski at 2022-08-25T20:06:46-04:00 Fix redundant import This fixes a build error on x86_64-linux-alpine3_12-validate. See the function 'loadExternalPlugins' defined in this file. - - - - - 4786acf7 by sheaf at 2022-08-26T15:05:23-04:00 Pmc: consider any 2 dicts of the same type equal This patch massages the keys used in the `TmOracle` `CoreMap` to ensure that dictionaries of coherent classes give the same key. That is, whenever we have an expression we want to insert or lookup in the `TmOracle` `CoreMap`, we first replace any dictionary `$dict_abcd :: ct` with a value of the form `error @ct`. This allows us to common-up view pattern functions with required constraints whose arguments differed only in the uniques of the dictionaries they were provided, thus fixing #21662. This is a rather ad-hoc change to the keys used in the `TmOracle` `CoreMap`. In the long run, we would probably want to use a different representation for the keys instead of simply using `CoreExpr` as-is. This more ambitious plan is outlined in #19272. Fixes #21662 Updates unix submodule - - - - - f5e0f086 by Krzysztof Gogolewski at 2022-08-26T15:06:01-04:00 Remove label style from printing context Previously, the SDocContext used for code generation contained information whether the labels should use Asm or C style. However, at every individual call site, this is known statically. This removes the parameter to 'PprCode' and replaces every 'pdoc' used to print a label in code style with 'pprCLabel' or 'pprAsmLabel'. The OutputableP instance is now used only for dumps. The output of T15155 changes, it now uses the Asm style (which is faithful to what actually happens). - - - - - 1007829b by Cheng Shao at 2022-08-26T15:06:40-04:00 boot: cleanup legacy args Cleanup legacy boot script args, following removal of the legacy make build system. - - - - - 95fe09da by Simon Peyton Jones at 2022-08-27T00:29:02-04:00 Improve SpecConstr for evals As #21763 showed, we were over-specialising in some cases, when the function involved was doing a simple 'eval', but not taking the value apart, or branching on it. This MR fixes the problem. See Note [Do not specialise evals]. Nofib barely budges, except that spectral/cichelli allocates about 3% less. Compiler bytes-allocated improves a bit geo. mean -0.1% minimum -0.5% maximum +0.0% The -0.5% is on T11303b, for what it's worth. - - - - - 565a8ec8 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Revert "Revert "Refactor SpecConstr to use treat bindings uniformly"" This reverts commit 851d8dd89a7955864b66a3da8b25f1dd88a503f8. This commit was originally reverted due to an increase in space usage. This was diagnosed as because the SCE increased in size and that was being retained by another leak. See #22102 - - - - - 82ce1654 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Avoid retaining bindings via ModGuts held on the stack It's better to overwrite the bindings fields of the ModGuts before starting an iteration as then all the old bindings can be collected as soon as the simplifier has processed them. Otherwise we end up with the old bindings being alive until right at the end of the simplifier pass as the mg_binds field is only modified right at the end. - - - - - 64779dcd by Matthew Pickering at 2022-08-27T00:29:39-04:00 Force imposs_deflt_cons in filterAlts This fixes a pretty serious space leak as the forced thunk would retain `Alt b` values which would then contain reference to a lot of old bindings and other simplifier gunk. The OtherCon unfolding was not forced on subsequent simplifier runs so more and more old stuff would be retained until the end of simplification. Fixing this has a drastic effect on maximum residency for the mmark package which goes from ``` 45,005,401,056 bytes allocated in the heap 17,227,721,856 bytes copied during GC 818,281,720 bytes maximum residency (33 sample(s)) 9,659,144 bytes maximum slop 2245 MiB total memory in use (0 MB lost due to fragmentation) ``` to ``` 45,039,453,304 bytes allocated in the heap 13,128,181,400 bytes copied during GC 331,546,608 bytes maximum residency (40 sample(s)) 7,471,120 bytes maximum slop 916 MiB total memory in use (0 MB lost due to fragmentation) ``` See #21993 for some more discussion. - - - - - a3b23a33 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Use Solo to avoid retaining the SCE but to avoid performing the substitution The use of Solo here allows us to force the selection into the SCE to obtain the Subst but without forcing the substitution to be applied. The resulting thunk is placed into a lazy field which is rarely forced, so forcing it regresses peformance. - - - - - 161a6f1f by Simon Peyton Jones at 2022-08-27T00:30:14-04:00 Fix a nasty loop in Tidy As the remarkably-simple #22112 showed, we were making a black hole in the unfolding of a self-recursive binding. Boo! It's a bit tricky. Documented in GHC.Iface.Tidy, Note [tidyTopUnfolding: avoiding black holes] - - - - - 68e6786f by Giles Anderson at 2022-08-29T00:01:35+02:00 Use TcRnDiagnostic in GHC.Tc.TyCl.Class (#20117) The following `TcRnDiagnostic` messages have been introduced: TcRnIllegalHsigDefaultMethods TcRnBadGenericMethod TcRnWarningMinimalDefIncomplete TcRnDefaultMethodForPragmaLacksBinding TcRnIgnoreSpecialisePragmaOnDefMethod TcRnBadMethodErr TcRnNoExplicitAssocTypeOrDefaultDeclaration - - - - - cbe51ac5 by Simon Peyton Jones at 2022-08-29T04:18:57-04:00 Fix a bug in anyInRnEnvR This bug was a subtle error in anyInRnEnvR, introduced by commit d4d3fe6e02c0eb2117dbbc9df72ae394edf50f06 Author: Andreas Klebinger <klebinger.andreas at gmx.at> Date: Sat Jul 9 01:19:52 2022 +0200 Rule matching: Don't compute the FVs if we don't look at them. The net result was #22028, where a rewrite rule would wrongly match on a lambda. The fix to that function is easy. - - - - - 0154bc80 by sheaf at 2022-08-30T06:05:41-04:00 Various Hadrian bootstrapping fixes - Don't always produce a distribution archive (#21629) - Use correct executable names for ghc-pkg and hsc2hs on windows (we were missing the .exe file extension) - Fix a bug where we weren't using the right archive format on Windows when unpacking the bootstrap sources. Fixes #21629 - - - - - 451b1d90 by Matthew Pickering at 2022-08-30T06:06:16-04:00 ci: Attempt using normal submodule cloning strategy We do not use any recursively cloned submodules, and this protects us from flaky upstream remotes. Fixes #22121 - - - - - 9d5ad7c4 by Pi Delport at 2022-08-30T22:40:46+00:00 Fix typo in Any docs: stray "--" - - - - - 3a002632 by Pi Delport at 2022-08-30T22:40:46+00:00 Fix typo in Any docs: syntatic -> syntactic - - - - - 7f490b13 by Simon Peyton Jones at 2022-08-31T03:53:54-04:00 Add a missing trimArityType This buglet was exposed by #22114, a consequence of my earlier refactoring of arity for join points. - - - - - e6fc820f by Ben Gamari at 2022-08-31T13:16:01+01:00 Bump binary submodule to 0.8.9.1 - - - - - 4c1e7b22 by Ben Gamari at 2022-08-31T13:16:01+01:00 Bump stm submodule to 2.5.1.0 - - - - - 837472b4 by Ben Gamari at 2022-08-31T13:16:01+01:00 users-guide: Document system-cxx-std-lib - - - - - f7a9947a by Douglas Wilson at 2022-08-31T13:16:01+01:00 Update submodule containers to 0.6.6 - - - - - 4ab1c2ca by Douglas Wilson at 2022-08-31T13:16:02+01:00 Update submodule process to 1.6.15.0 - - - - - 1309ea1e by Ben Gamari at 2022-08-31T13:16:02+01:00 Bump directory submodule to 1.3.7.1 - - - - - 7962a33a by Douglas Wilson at 2022-08-31T13:16:02+01:00 Bump text submodule to 2.0.1 - - - - - fd8d80c3 by Ben Gamari at 2022-08-31T13:26:52+01:00 Bump deepseq submodule to 1.4.8.0 - - - - - a9baafac by Ben Gamari at 2022-08-31T13:26:52+01:00 Add dates to base, ghc-prim changelogs - - - - - 2cee323c by Ben Gamari at 2022-08-31T13:26:52+01:00 Update autoconf scripts Scripts taken from autoconf 02ba26b218d3d3db6c56e014655faf463cefa983 - - - - - e62705ff by Ben Gamari at 2022-08-31T13:26:53+01:00 Bump bytestring submodule to 0.11.3.1 - - - - - f7b4dcbd by Douglas Wilson at 2022-08-31T13:26:53+01:00 Update submodule Cabal to tag Cabal-v3.8.1.0 closes #21931 - - - - - e8eaf807 by Matthew Pickering at 2022-08-31T18:27:57-04:00 Refine in-tree compiler args for --test-compiler=stage1 Some of the logic to calculate in-tree arguments was not correct for the stage1 compiler. Namely we were not correctly reporting whether we were building static or dynamic executables and whether debug assertions were enabled. Fixes #22096 - - - - - 6b2f7ffe by Matthew Pickering at 2022-08-31T18:27:57-04:00 Make ghcDebugAssertions into a Stage predicate (Stage -> Bool) We also care whether we have debug assertions enabled for a stage one compiler, but the way which we turned on the assertions was quite different from the stage2 compiler. This makes the logic for turning on consistent across both and has the advantage of being able to correct determine in in-tree args whether a flavour enables assertions or not. Ticket #22096 - - - - - 15111af6 by Zubin Duggal at 2022-09-01T01:18:50-04:00 Add regression test for #21550 This was fixed by ca90ffa321a31842a32be1b5b6e26743cd677ec5 "Use local instances with least superclass depth" - - - - - 7d3a055d by Krzysztof Gogolewski at 2022-09-01T01:19:26-04:00 Minor cleanup - Remove mkHeteroCoercionType, sdocImpredicativeTypes, isStateType (unused), isCoVar_maybe (duplicated by getCoVar_maybe) - Replace a few occurrences of voidPrimId with (# #). void# is a deprecated synonym for the unboxed tuple. - Use showSDoc in :show linker. This makes it consistent with the other :show commands - - - - - 31a8989a by Tommy Bidne at 2022-09-01T12:01:20-04:00 Change Ord defaults per CLC proposal Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/24#issuecomment-1233331267 - - - - - 7f527f01 by Matthew Pickering at 2022-09-01T12:01:56-04:00 Fix bootstrap with ghc-9.0 It turns out Solo is a very recent addition to base, so for older GHC versions we just defined it inline here the one place we use it in the compiler. - - - - - d2be80fd by Sebastian Graf at 2022-09-05T23:12:14-04:00 DmdAnal: Don't panic in addCaseBndrDmd (#22039) Rather conservatively return Top. See Note [Untyped demand on case-alternative binders]. I also factored `addCaseBndrDmd` into two separate functions `scrutSubDmd` and `fieldBndrDmds`. Fixes #22039. - - - - - 25f68ace by Ben Gamari at 2022-09-05T23:12:50-04:00 gitlab-ci: Ensure that ghc derivation is in scope Previously the lint-ci job attempted to use cabal-install (specifically `cabal update`) without a GHC in PATH. However, cabal-install-3.8 appears to want GHC, even for `cabal update`. - - - - - f37b621f by sheaf at 2022-09-06T11:51:53+00:00 Update instances.rst, clarifying InstanceSigs Fixes #22103 - - - - - d4f908f7 by Jan Hrček at 2022-09-06T15:36:58-04:00 Fix :add docs in user guide - - - - - 808bb793 by Cheng Shao at 2022-09-06T15:37:35-04:00 ci: remove unused build_make/test_make in ci script - - - - - d0a2efb2 by Eric Lindblad at 2022-09-07T16:42:45-04:00 typo - - - - - fac0098b by Eric Lindblad at 2022-09-07T16:42:45-04:00 typos - - - - - a581186f by Eric Lindblad at 2022-09-07T16:42:45-04:00 whitespace - - - - - 04a738cb by Cheng Shao at 2022-09-07T16:43:22-04:00 CmmToAsm: remove unused ModLocation from NatM_State - - - - - ee1cfaa9 by Krzysztof Gogolewski at 2022-09-07T16:43:58-04:00 Minor SDoc cleanup Change calls to renderWithContext with showSDocOneLine; it's more efficient and explanatory. Remove polyPatSig (unused) - - - - - 7918265d by Krzysztof Gogolewski at 2022-09-07T16:43:58-04:00 Remove Outputable Char instance Use 'text' instead of 'ppr'. Using 'ppr' on the list "hello" rendered as "h,e,l,l,o". - - - - - 77209ab3 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Export liftA2 from Prelude Changes: In order to be warning free and compatible, we hide Applicative(..) from Prelude in a few places and instead import it directly from Control.Applicative. Please see the migration guide at https://github.com/haskell/core-libraries-committee/blob/main/guides/export-lifta2-prelude.md for more details. This means that Applicative is now exported in its entirety from Prelude. Motivation: This change is motivated by a few things: * liftA2 is an often used function, even more so than (<*>) for some people. * When implementing Applicative, the compiler will prompt you for either an implementation of (<*>) or of liftA2, but trying to use the latter ends with an error, without further imports. This could be confusing for newbies. * For teaching, it is often times easier to introduce liftA2 first, as it is a natural generalisation of fmap. * This change seems to have been unanimously and enthusiastically accepted by the CLC members, possibly indicating a lot of love for it. * This change causes very limited breakage, see the linked issue below for an investigation on this. See https://github.com/haskell/core-libraries-committee/issues/50 for the surrounding discussion and more details. - - - - - 442a94e8 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Add changelog entry for liftA2 export from Prelude - - - - - fb968680 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Bump submodule containers to one with liftA2 warnings fixed - - - - - f54ff818 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Bump submodule Cabal to one with liftA2 warnings fixed - - - - - a4b34808 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Isolate some Applicative hidings to GHC.Prelude By reexporting the entirety of Applicative from GHC.Prelude, we can save ourselves some `hiding` and importing of `Applicative` in consumers of GHC.Prelude. This also has the benefit of isolating this type of change to GHC.Prelude, so that people in the future don't have to think about it. - - - - - 9c4ea90c by Cheng Shao at 2022-09-08T17:49:47-04:00 CmmToC: enable 64-bit CallishMachOp on 32-bit targets Normally, the unregisterised builds avoid generating 64-bit CallishMachOp in StgToCmm, so CmmToC doesn't support these. However, there do exist cases where we'd like to invoke cmmToC for other cmm inputs which may contain such CallishMachOps, and it's a rather low effort to add support for these since they only require calling into existing ghc-prim cbits. - - - - - 04062510 by Alexis King at 2022-09-11T11:30:32+02:00 Add native delimited continuations to the RTS This patch implements GHC proposal 313, "Delimited continuation primops", by adding native support for delimited continuations to the GHC RTS. All things considered, the patch is relatively small. It almost exclusively consists of changes to the RTS; the compiler itself is essentially unaffected. The primops come with fairly extensive Haddock documentation, and an overview of the implementation strategy is given in the Notes in rts/Continuation.c. This first stab at the implementation prioritizes simplicity over performance. Most notably, every continuation is always stored as a single, contiguous chunk of stack. If one of these chunks is particularly large, it can result in poor performance, as the current implementation does not attempt to cleverly squeeze a subset of the stack frames into the existing stack: it must fit all at once. If this proves to be a performance issue in practice, a cleverer strategy would be a worthwhile target for future improvements. - - - - - ee471dfb by Cheng Shao at 2022-09-12T07:07:33-04:00 rts: fix missing dirty_MVAR argument in stg_writeIOPortzh - - - - - a5f9c35f by Cheng Shao at 2022-09-12T13:29:05-04:00 ci: enable parallel compression for xz - - - - - 3a815f30 by Ryan Scott at 2022-09-12T13:29:41-04:00 Windows: Always define _UCRT when compiling C code As seen in #22159, this is required to ensure correct behavior when MinGW-w64 headers are in the `C_INCLUDE_PATH`. Fixes #22159. - - - - - 65a0bd69 by sheaf at 2022-09-13T10:27:52-04:00 Add diagnostic codes This MR adds diagnostic codes, assigning unique numeric codes to error and warnings, e.g. error: [GHC-53633] Pattern match is redundant This is achieved as follows: - a type family GhcDiagnosticCode that gives the diagnostic code for each diagnostic constructor, - a type family ConRecursInto that specifies whether to recur into an argument of the constructor to obtain a more fine-grained code (e.g. different error codes for different 'deriving' errors), - generics machinery to generate the value-level function assigning each diagnostic its error code; see Note [Diagnostic codes using generics] in GHC.Types.Error.Codes. The upshot is that, to add a new diagnostic code, contributors only need to modify the two type families mentioned above. All logic relating to diagnostic codes is thus contained to the GHC.Types.Error.Codes module, with no code duplication. This MR also refactors error message datatypes a bit, ensuring we can derive Generic for them, and cleans up the logic around constraint solver reports by splitting up 'TcSolverReportInfo' into separate datatypes (see #20772). Fixes #21684 - - - - - 362cca13 by sheaf at 2022-09-13T10:27:53-04:00 Diagnostic codes: acccept test changes The testsuite output now contains diagnostic codes, so many tests need to be updated at once. We decided it was best to keep the diagnostic codes in the testsuite output, so that contributors don't inadvertently make changes to the diagnostic codes. - - - - - 08f6730c by Adam Gundry at 2022-09-13T10:28:29-04:00 Allow imports to reference multiple fields with the same name (#21625) If a module `M` exports two fields `f` (using DuplicateRecordFields), we can still accept import M (f) import M hiding (f) and treat `f` as referencing both of them. This was accepted in GHC 9.0, but gave rise to an ambiguity error in GHC 9.2. See #21625. This patch also documents this behaviour in the user's guide, and updates the test for #16745 which is now treated differently. - - - - - c14370d7 by Cheng Shao at 2022-09-13T10:29:07-04:00 ci: remove unused appveyor config - - - - - dc6af9ed by Cheng Shao at 2022-09-13T10:29:45-04:00 compiler: remove unused lazy state monad - - - - - 646d15ad by Eric Lindblad at 2022-09-14T03:13:56-04:00 Fix typos This fixes various typos and spelling mistakes in the compiler. Fixes #21891 - - - - - 7d7e71b0 by Matthew Pickering at 2022-09-14T03:14:32-04:00 hadrian: Bump index state This bumps the index state so a build plan can also be found when booting with 9.4. Fixes #22165 - - - - - 98b62871 by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Use a stamp file to record when a package is built in a certain way Before this patch which library ways we had built wasn't recorded directly. So you would run into issues if you build the .conf file with some library ways before switching the library ways which you wanted to build. Now there is one stamp file for each way, so in order to build a specific way you can need that specific stamp file rather than going indirectly via the .conf file. - - - - - b42cedbe by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Inplace/Final package databases There are now two different package databases per stage. An inplace package database contains .conf files which point directly into the build directories. The final package database contains .conf files which point into the installed locations. The inplace .conf files are created before any building happens and have fake ABI hash values. The final .conf files are created after a package finished building and contains the proper ABI has. The motivation for this is to make the dependency structure more fine-grained when building modules. Now a module depends just depends directly on M.o from package p rather than the .conf file depend on the .conf file for package p. So when all of a modules direct dependencies have finished building we can start building it rather than waiting for the whole package to finish. The secondary motivation is that the multi-repl doesn't need to build everything before starting the multi-repl session. We can just configure the inplace package-db and use that in order to start the repl. - - - - - 6515c32b by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Add some more packages to multi-cradle The main improvement here is to pass `-this-unit-id` for executables so that they can be added to the multi-cradle if desired as well as normal library packages. - - - - - e470e91f by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Need builders needed by Cabal Configure in parallel Because of the use of withStaged (which needs the necessary builder) when configuring a package, the builds of stage1:exe:ghc-bin and stage1:exe:ghc-pkg where being linearised when building a specific target like `binary-dist-dir`. Thankfully the fix is quite local, to supply all the `withStaged` arguments together so the needs can be batched together and hence performed in parallel. Fixes #22093 - - - - - c4438347 by Matthew Pickering at 2022-09-14T17:17:04-04:00 Remove stage1:exe:ghc-bin pre-build from CI script CI builds stage1:exe:ghc-bin before the binary-dist target which introduces some quite bad linearisation (see #22093) because we don't build stage1 compiler in parallel with anything. Then when the binary-dist target is started we have to build stage1:exe:ghc-pkg before doing anything. Fixes #22094 - - - - - 71d8db86 by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Add extra implicit dependencies from DeriveLift ghc -M should know that modules which use DeriveLift (or TemplateHaskellQuotes) need TH.Lib.Internal but until it does, we have to add these extra edges manually or the modules will be compiled before TH.Lib.Internal is compiled which leads to a desugarer error. - - - - - 43e574f0 by Greg Steuck at 2022-09-14T17:17:43-04:00 Repair c++ probing on OpenBSD Failure without this change: ``` checking C++ standard library flavour... libc++ checking for linkage against 'c++ c++abi'... failed checking for linkage against 'c++ cxxrt'... failed configure: error: Failed to find C++ standard library ``` - - - - - 534b39ee by Douglas Wilson at 2022-09-14T17:18:21-04:00 libraries: template-haskell: vendor filepath differently Vendoring with ../ in hs-source-dirs prevents upload to hackage. (cherry picked from commit 1446be7586ba70f9136496f9b67f792955447842) - - - - - bdd61cd6 by M Farkas-Dyck at 2022-09-14T22:39:34-04:00 Unbreak Hadrian with Cabal 3.8. - - - - - df04d6ec by Krzysztof Gogolewski at 2022-09-14T22:40:09-04:00 Fix typos - - - - - d6ea8356 by Andreas Klebinger at 2022-09-15T10:12:41+02:00 Tag inference: Fix #21954 by retaining tagsigs of vars in function position. For an expression like: case x of y Con z -> z If we also retain the tag sig for z we can generate code to immediately return it rather than calling out to stg_ap_0_fast. - - - - - 7cce7007 by Andreas Klebinger at 2022-09-15T10:12:42+02:00 Stg.InferTags.Rewrite - Avoid some thunks. - - - - - 88c4cbdb by Cheng Shao at 2022-09-16T13:57:56-04:00 hadrian: enable -fprof-late only for profiling ways - - - - - d7235831 by Cheng Shao at 2022-09-16T13:57:56-04:00 hadrian: add late_ccs flavour transformer - - - - - ce203753 by Cheng Shao at 2022-09-16T13:58:34-04:00 configure: remove unused program checks - - - - - 9b4c1056 by Pierre Le Marre at 2022-09-16T13:59:16-04:00 Update to Unicode 15.0 - - - - - c6e9b89a by Bodigrim at 2022-09-16T13:59:55-04:00 Avoid partial head and tail in ghc-heap; replace with total pattern-matching - - - - - 616afde3 by Cheng Shao at 2022-09-16T14:00:33-04:00 hadrian: relax Cabal upper bound to allow building with Cabal-3.8 A follow up of !8910. - - - - - df35d994 by Alexis King at 2022-09-16T14:01:11-04:00 Add links to the continuations haddocks in the docs for each primop fixes #22176 - - - - - 383f7549 by Matthew Pickering at 2022-09-16T21:42:10-04:00 -Wunused-pattern-binds: Recurse into patterns to check whether there's a splice See the examples in #22057 which show we have to traverse deeply into a pattern to determine whether it contains a splice or not. The original implementation pointed this out but deemed this very shallow traversal "too expensive". Fixes #22057 I also fixed an oversight in !7821 which meant we lost a warning which was present in 9.2.2. Fixes #22067 - - - - - 5031bf49 by sheaf at 2022-09-16T21:42:49-04:00 Hadrian: Don't try to build terminfo on Windows Commit b42cedbe introduced a dependency on terminfo on Windows, but that package isn't available on Windows. - - - - - c9afe221 by M Farkas-Dyck at 2022-09-17T06:44:47-04:00 Clean up some. In particular: • Delete some dead code, largely under `GHC.Utils`. • Clean up a few definitions in `GHC.Utils.(Misc, Monad)`. • Clean up `GHC.Types.SrcLoc`. • Derive stock `Functor, Foldable, Traversable` for more types. • Derive more instances for newtypes. Bump haddock submodule. - - - - - 85431ac3 by Cheng Shao at 2022-09-17T06:45:25-04:00 driver: pass original Cmm filename in ModLocation When compiling Cmm, the ml_hs_file field is used to indicate Cmm filename when later generating DWARF information. We should pass the original filename here, otherwise for preprocessed Cmm files, the filename will be a temporary filename which is confusing. - - - - - 63aa0069 by Cheng Shao at 2022-09-17T06:46:04-04:00 rts: remove legacy logging cabal flag - - - - - bd0f4184 by Cheng Shao at 2022-09-17T06:46:04-04:00 rts: make threaded ways optional For certain targets (e.g. wasm32-wasi), the threaded rts is known not to work. This patch adds a "threaded" cabal flag to rts to make threaded rts ways optional. Hadrian enables this flag iff the flavour rtsWays contains threaded ways. - - - - - 8a666ad2 by Ryan Scott at 2022-09-18T08:00:44-04:00 DeriveFunctor: Check for last type variables using dataConUnivTyVars Previously, derived instances of `Functor` (as well as the related classes `Foldable`, `Traversable`, and `Generic1`) would determine which constraints to infer by checking for fields that contain the last type variable. The problem was that this last type variable was taken from `tyConTyVars`. For GADTs, the type variables in each data constructor are _not_ the same type variables as in `tyConTyVars`, leading to #22167. This fixes the issue by instead checking for the last type variable using `dataConUnivTyVars`. (This is very similar in spirit to the fix for #21185, which also replaced an errant use of `tyConTyVars` with type variables from each data constructor.) Fixes #22167. - - - - - 78037167 by Vladislav Zavialov at 2022-09-18T08:01:20-04:00 Lexer: pass updated buffer to actions (#22201) In the lexer, predicates have the following type: { ... } :: user -- predicate state -> AlexInput -- input stream before the token -> Int -- length of the token -> AlexInput -- input stream after the token -> Bool -- True <=> accept the token This is documented in the Alex manual. There is access to the input stream both before and after the token. But when the time comes to construct the token, GHC passes only the initial string buffer to the lexer action. This patch fixes it: - type Action = PsSpan -> StringBuffer -> Int -> P (PsLocated Token) + type Action = PsSpan -> StringBuffer -> Int -> StringBuffer -> P (PsLocated Token) Now lexer actions have access to the string buffer both before and after the token, just like the predicates. It's just a matter of passing an additional function parameter throughout the lexer. - - - - - 75746594 by Vladislav Zavialov at 2022-09-18T08:01:20-04:00 Lexer: define varsym without predicates (#22201) Before this patch, the varsym lexing rules were defined as follows: <0> { @varsym / { precededByClosingToken `alexAndPred` followedByOpeningToken } { varsym_tight_infix } @varsym / { followedByOpeningToken } { varsym_prefix } @varsym / { precededByClosingToken } { varsym_suffix } @varsym { varsym_loose_infix } } Unfortunately, this meant that the predicates 'precededByClosingToken' and 'followedByOpeningToken' were recomputed several times before we could figure out the whitespace context. With this patch, we check for whitespace context directly in the lexer action: <0> { @varsym { with_op_ws varsym } } The checking for opening/closing tokens happens in 'with_op_ws' now, which is part of the lexer action rather than the lexer predicate. - - - - - c1f81b38 by M Farkas-Dyck at 2022-09-19T09:07:05-04:00 Scrub partiality about `NewOrData`. Rather than a list of constructors and a `NewOrData` flag, we define `data DataDefnCons a = NewTypeCon a | DataTypeCons [a]`, which enforces a newtype to have exactly one constructor. Closes #22070. Bump haddock submodule. - - - - - 1e1ed8c5 by Cheng Shao at 2022-09-19T09:07:43-04:00 CmmToC: emit __builtin_unreachable() after noreturn ccalls Emit a __builtin_unreachable() call after a foreign call marked as CmmNeverReturns. This is crucial to generate correctly typed code for wasm; as for other archs, this is also beneficial for the C compiler optimizations. - - - - - 19f45a25 by Jan Hrček at 2022-09-20T03:49:29-04:00 Document :unadd GHCi command in user guide - - - - - 545ff490 by sheaf at 2022-09-20T03:50:06-04:00 Hadrian: merge archives even in stage 0 We now always merge .a archives when ar supports -L. This change is necessary in order to bootstrap GHC using GHC 9.4 on Windows, as nested archives aren't supported. Not doing so triggered bug #21990 when trying to use the Win32 package, with errors such as: Not a x86_64 PE+ file. Unknown COFF 4 type in getHeaderInfo. ld.lld: error: undefined symbol: Win32zm2zi12zi0zi0_SystemziWin32ziConsoleziCtrlHandler_withConsoleCtrlHandler1_info We have to be careful about which ar is meant: in stage 0, the check should be done on the system ar (system-ar in system.config). - - - - - 59fe128c by Vladislav Zavialov at 2022-09-20T03:50:42-04:00 Fix -Woperator-whitespace for consym (part of #19372) Due to an oversight, the initial specification and implementation of -Woperator-whitespace focused on varsym exclusively and completely ignored consym. This meant that expressions such as "x+ y" would produce a warning, while "x:+ y" would not. The specification was corrected in ghc-proposals pull request #404, and this patch updates the implementation accordingly. Regression test included. - - - - - c4c2cca0 by John Ericson at 2022-09-20T13:11:49-04:00 Add `Eq` and `Ord` instances for `Generically1` These are needed so the subsequent commit overhauling the `*1` classes type-checks. - - - - - 7beb356e by John Ericson at 2022-09-20T13:11:50-04:00 Relax instances for Functor combinators; put superclass on Class1 and Class2 to make non-breaking This change is approved by the Core Libraries commitee in https://github.com/haskell/core-libraries-committee/issues/10 The first change makes the `Eq`, `Ord`, `Show`, and `Read` instances for `Sum`, `Product`, and `Compose` match those for `:+:`, `:*:`, and `:.:`. These have the proper flexible contexts that are exactly what the instance needs: For example, instead of ```haskell instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where (==) = eq1 ``` we do ```haskell deriving instance Eq (f (g a)) => Eq (Compose f g a) ``` But, that change alone is rather breaking, because until now `Eq (f a)` and `Eq1 f` (and respectively the other classes and their `*1` equivalents too) are *incomparable* constraints. This has always been an annoyance of working with the `*1` classes, and now it would rear it's head one last time as an pesky migration. Instead, we give the `*1` classes superclasses, like so: ```haskell (forall a. Eq a => Eq (f a)) => Eq1 f ``` along with some laws that canonicity is preserved, like: ```haskell liftEq (==) = (==) ``` and likewise for `*2` classes: ```haskell (forall a. Eq a => Eq1 (f a)) => Eq2 f ``` and laws: ```haskell liftEq2 (==) = liftEq1 ``` The `*1` classes also have default methods using the `*2` classes where possible. What this means, as explained in the docs, is that `*1` classes really are generations of the regular classes, indicating that the methods can be split into a canonical lifting combined with a canonical inner, with the super class "witnessing" the laws[1] in a fashion. Circling back to the pragmatics of migrating, note that the superclass means evidence for the old `Sum`, `Product`, and `Compose` instances is (more than) sufficient, so breakage is less likely --- as long no instances are "missing", existing polymorphic code will continue to work. Breakage can occur when a datatype implements the `*1` class but not the corresponding regular class, but this is almost certainly an oversight. For example, containers made that mistake for `Tree` and `Ord`, which I fixed in https://github.com/haskell/containers/pull/761, but fixing the issue by adding `Ord1` was extremely *un*controversial. `Generically1` was also missing `Eq`, `Ord`, `Read,` and `Show` instances. It is unlikely this would have been caught without implementing this change. ----- [1]: In fact, someday, when the laws are part of the language and not only documentation, we might be able to drop the superclass field of the dictionary by using the laws to recover the superclass in an instance-agnostic manner, e.g. with a *non*-overloaded function with type: ```haskell DictEq1 f -> DictEq a -> DictEq (f a) ``` But I don't wish to get into optomizations now, just demonstrate the close relationship between the law and the superclass. Bump haddock submodule because of test output changing. - - - - - 6a8c6b5e by Tom Ellis at 2022-09-20T13:12:27-04:00 Add notes to ghc-prim Haddocks that users should not import it - - - - - ee9d0f5c by matoro at 2022-09-20T13:13:06-04:00 docs: clarify that LLVM codegen is not available in unregisterised mode The current docs are misleading and suggest that it is possible to use LLVM codegen from an unregisterised build. This is not the case; attempting to pass `-fllvm` to an unregisterised build warns: ``` when making flags consistent: warning: Target platform uses unregisterised ABI, so compiling via C ``` and uses the C codegen anyway. - - - - - 854224ed by Nicolas Trangez at 2022-09-20T20:14:29-04:00 rts: remove copy-paste error from `cabal.rts.in` This was, likely accidentally, introduced in 4bf542bf1c. See: 4bf542bf1cdf2fa468457fc0af21333478293476 - - - - - c8ae3add by Matthew Pickering at 2022-09-20T20:15:04-04:00 hadrian: Add extra_dependencies edges for all different ways The hack to add extra dependencies needed by DeriveLift extension missed the cases for profiles and dynamic ways. For the profiled way this leads to errors like: ``` GHC error in desugarer lookup in Data.IntSet.Internal: Failed to load interface for ‘Language.Haskell.TH.Lib.Internal’ Perhaps you haven't installed the profiling libraries for package ‘template-haskell’? Use -v (or `:set -v` in ghci) to see a list of the files searched for. ghc: panic! (the 'impossible' happened) GHC version 9.5.20220916: initDs ``` Therefore the fix is to add these extra edges in. Fixes #22197 - - - - - a971657d by Mon Aaraj at 2022-09-21T06:41:24+03:00 users-guide: fix incorrect ghcappdata folder for unix and windows - - - - - 06ccad0d by sheaf at 2022-09-21T08:28:49-04:00 Don't use isUnliftedType in isTagged The function GHC.Stg.InferTags.Rewrite.isTagged can be given the Id of a join point, which might be representation polymorphic. This would cause the call to isUnliftedType to crash. It's better to use typeLevity_maybe instead. Fixes #22212 - - - - - c0ba775d by Teo Camarasu at 2022-09-21T14:30:37-04:00 Add fragmentation statistic to GHC.Stats Implements #21537 - - - - - 2463df2f by Torsten Schmits at 2022-09-21T14:31:24-04:00 Rename Solo[constructor] to MkSolo Part of proposal 475 (https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0475-tuple-syntax.rst) Moves all tuples to GHC.Tuple.Prim Updates ghc-prim version (and bumps bounds in dependents) updates haddock submodule updates deepseq submodule updates text submodule - - - - - 9034fada by Matthew Pickering at 2022-09-22T09:25:29-04:00 Update filepath to filepath-1.4.100.0 Updates submodule * Always rely on vendored filepath * filepath must be built as stage0 dependency because it uses template-haskell. Towards #22098 - - - - - 615e2278 by Krzysztof Gogolewski at 2022-09-22T09:26:05-04:00 Minor refactor around Outputable * Replace 'text . show' and 'ppr' with 'int'. * Remove Outputable.hs-boot, no longer needed * Use pprWithCommas * Factor out instructions in AArch64 codegen - - - - - aeafdba5 by Sebastian Graf at 2022-09-27T15:14:54+02:00 Demand: Clear distinction between Call SubDmd and eval Dmd (#21717) In #21717 we saw a reportedly unsound strictness signature due to an unsound definition of plusSubDmd on Calls. This patch contains a description and the fix to the unsoundness as outlined in `Note [Call SubDemand vs. evaluation Demand]`. This fix means we also get rid of the special handling of `-fpedantic-bottoms` in eta-reduction. Thanks to less strict and actually sound strictness results, we will no longer eta-reduce the problematic cases in the first place, even without `-fpedantic-bottoms`. So fixing the unsoundness also makes our eta-reduction code simpler with less hacks to explain. But there is another, more unfortunate side-effect: We *unfix* #21085, but fortunately we have a new fix ready: See `Note [mkCall and plusSubDmd]`. There's another change: I decided to make `Note [SubDemand denotes at least one evaluation]` a lot simpler by using `plusSubDmd` (instead of `lubPlusSubDmd`) even if both argument demands are lazy. That leads to less precise results, but in turn rids ourselves from the need for 4 different `OpMode`s and the complication of `Note [Manual specialisation of lub*Dmd/plus*Dmd]`. The result is simpler code that is in line with the paper draft on Demand Analysis. I left the abandoned idea in `Note [Unrealised opportunity in plusDmd]` for posterity. The fallout in terms of regressions is negligible, as the testsuite and NoFib shows. ``` Program Allocs Instrs -------------------------------------------------------------------------------- hidden +0.2% -0.2% linear -0.0% -0.7% -------------------------------------------------------------------------------- Min -0.0% -0.7% Max +0.2% +0.0% Geometric Mean +0.0% -0.0% ``` Fixes #21717. - - - - - 9b1595c8 by Ross Paterson at 2022-09-27T14:12:01-04:00 implement proposal 106 (Define Kinds Without Promotion) (fixes #6024) includes corresponding changes to haddock submodule - - - - - c2d73cb4 by Andreas Klebinger at 2022-09-28T15:07:30-04:00 Apply some tricks to speed up core lint. Below are the noteworthy changes and if given their impact on compiler allocations for a type heavy module: * Use the oneShot trick on LintM * Use a unboxed tuple for the result of LintM: ~6% reduction * Avoid a thunk for the result of typeKind in lintType: ~5% reduction * lint_app: Don't allocate the error msg in the hot code path: ~4% reduction * lint_app: Eagerly force the in scope set: ~4% * nonDetCmpType: Try to short cut using reallyUnsafePtrEquality#: ~2% * lintM: Use a unboxed maybe for the `a` result: ~12% * lint_app: make go_app tail recursive to avoid allocating the go function as heap closure: ~7% * expandSynTyCon_maybe: Use a specialized data type For a less type heavy module like nofib/spectral/simple compiled with -O -dcore-lint allocations went down by ~24% and compile time by ~9%. ------------------------- Metric Decrease: T1969 ------------------------- - - - - - b74b6191 by sheaf at 2022-09-28T15:08:10-04:00 matchLocalInst: do domination analysis When multiple Given quantified constraints match a Wanted, and there is a quantified constraint that dominates all others, we now pick it to solve the Wanted. See Note [Use only the best matching quantified constraint]. For example: [G] d1: forall a b. ( Eq a, Num b, C a b ) => D a b [G] d2: forall a . C a Int => D a Int [W] {w}: D a Int When solving the Wanted, we find that both Givens match, but we pick the second, because it has a weaker precondition, C a Int, compared to (Eq a, Num Int, C a Int). We thus say that d2 dominates d1; see Note [When does a quantified instance dominate another?]. This domination test is done purely in terms of superclass expansion, in the function GHC.Tc.Solver.Interact.impliedBySCs. We don't attempt to do a full round of constraint solving; this simple check suffices for now. Fixes #22216 and #22223 - - - - - 2a53ac18 by Simon Peyton Jones at 2022-09-28T17:49:09-04:00 Improve aggressive specialisation This patch fixes #21286, by not unboxing dictionaries in worker/wrapper (ever). The main payload is tiny: * In `GHC.Core.Opt.DmdAnal.finaliseArgBoxities`, do not unbox dictionaries in `get_dmd`. See Note [Do not unbox class dictionaries] in that module * I also found that imported wrappers were being fruitlessly specialised, so I fixed that too, in canSpecImport. See Note [Specialising imported functions] point (2). In doing due diligence in the testsuite I fixed a number of other things: * Improve Note [Specialising unfoldings] in GHC.Core.Unfold.Make, and Note [Inline specialisations] in GHC.Core.Opt.Specialise, and remove duplication between the two. The new Note describes how we specialise functions with an INLINABLE pragma. And simplify the defn of `spec_unf` in `GHC.Core.Opt.Specialise.specCalls`. * Improve Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap. And (critially) make an actual change which is to propagate the user-written pragma from the original function to the wrapper; see `mkStrWrapperInlinePrag`. * Write new Note [Specialising imported functions] in GHC.Core.Opt.Specialise All this has a big effect on some compile times. This is compiler/perf, showing only changes over 1%: Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -50.2% GOOD ManyConstructors(normal) +1.0% MultiLayerModulesTH_OneShot(normal) +2.6% PmSeriesG(normal) -1.1% T10547(normal) -1.2% T11195(normal) -1.2% T11276(normal) -1.0% T11303b(normal) -1.6% T11545(normal) -1.4% T11822(normal) -1.3% T12150(optasm) -1.0% T12234(optasm) -1.2% T13056(optasm) -9.3% GOOD T13253(normal) -3.8% GOOD T15164(normal) -3.6% GOOD T16190(normal) -2.1% T16577(normal) -2.8% GOOD T16875(normal) -1.6% T17836(normal) +2.2% T17977b(normal) -1.0% T18223(normal) -33.3% GOOD T18282(normal) -3.4% GOOD T18304(normal) -1.4% T18698a(normal) -1.4% GOOD T18698b(normal) -1.3% GOOD T19695(normal) -2.5% GOOD T5837(normal) -2.3% T9630(normal) -33.0% GOOD WWRec(normal) -9.7% GOOD hard_hole_fits(normal) -2.1% GOOD hie002(normal) +1.6% geo. mean -2.2% minimum -50.2% maximum +2.6% I diligently investigated some of the big drops. * Caused by not doing w/w for dictionaries: T13056, T15164, WWRec, T18223 * Caused by not fruitlessly specialising wrappers LargeRecord, T9630 For runtimes, here is perf/should+_run: Metrics: runtime/bytes allocated -------------------------------- T12990(normal) -3.8% T5205(normal) -1.3% T9203(normal) -10.7% GOOD haddock.Cabal(normal) +0.1% haddock.base(normal) -1.1% haddock.compiler(normal) -0.3% lazy-bs-alloc(normal) -0.2% ------------------------------------------ geo. mean -0.3% minimum -10.7% maximum +0.1% I did not investigate exactly what happens in T9203. Nofib is a wash: +-------------------------------++--+-----------+-----------+ | || | tsv (rel) | std. err. | +===============================++==+===========+===========+ | real/anna || | -0.13% | 0.0% | | real/fem || | +0.13% | 0.0% | | real/fulsom || | -0.16% | 0.0% | | real/lift || | -1.55% | 0.0% | | real/reptile || | -0.11% | 0.0% | | real/smallpt || | +0.51% | 0.0% | | spectral/constraints || | +0.20% | 0.0% | | spectral/dom-lt || | +1.80% | 0.0% | | spectral/expert || | +0.33% | 0.0% | +===============================++==+===========+===========+ | geom mean || | | | +-------------------------------++--+-----------+-----------+ I spent quite some time investigating dom-lt, but it's pretty complicated. See my note on !7847. Conclusion: it's just a delicate inlining interaction, and we have plenty of those. Metric Decrease: LargeRecord T13056 T13253 T15164 T16577 T18223 T18282 T18698a T18698b T19695 T9630 WWRec hard_hole_fits T9203 - - - - - addeefc0 by Simon Peyton Jones at 2022-09-28T17:49:09-04:00 Refactor UnfoldingSource and IfaceUnfolding I finally got tired of the way that IfaceUnfolding reflected a previous structure of unfoldings, not the current one. This MR refactors UnfoldingSource and IfaceUnfolding to be simpler and more consistent. It's largely just a refactor, but in UnfoldingSource (which moves to GHC.Types.Basic, since it is now used in IfaceSyn too), I distinguish between /user-specified/ and /system-generated/ stable unfoldings. data UnfoldingSource = VanillaSrc | StableUserSrc -- From a user-specified pragma | StableSystemSrc -- From a system-generated unfolding | CompulsorySrc This has a minor effect in CSE (see the use of isisStableUserUnfolding in GHC.Core.Opt.CSE), which I tripped over when working on specialisation, but it seems like a Good Thing to know anyway. - - - - - 7be6f9a4 by Simon Peyton Jones at 2022-09-28T17:49:09-04:00 INLINE/INLINEABLE pragmas in Foreign.Marshal.Array Foreign.Marshal.Array contains many small functions, all of which are overloaded, and which are critical for performance. Yet none of them had pragmas, so it was a fluke whether or not they got inlined. This patch makes them all either INLINE (small ones) or INLINEABLE and hence specialisable (larger ones). See Note [Specialising array operations] in that module. - - - - - b0c89dfa by Jade Lovelace at 2022-09-28T17:49:49-04:00 Export OnOff from GHC.Driver.Session I was working on fixing an issue where HLS was trying to pass its DynFlags to HLint, but didn't pass any of the disabled language extensions, which HLint would then assume are on because of their default values. Currently it's not possible to get any of the "No" flags because the `DynFlags.extensions` field can't really be used since it is [OnOff Extension] and OnOff is not exported. So let's export it. - - - - - 2f050687 by Bodigrim at 2022-09-28T17:50:28-04:00 Avoid Data.List.group; prefer Data.List.NonEmpty.group This allows to avoid further partiality, e. g., map head . group is replaced by map NE.head . NE.group, and there are less panic calls. - - - - - bc0020fa by M Farkas-Dyck at 2022-09-28T22:51:59-04:00 Clean up `findWiredInUnit`. In particular, avoid `head`. - - - - - 6a2eec98 by Bodigrim at 2022-09-28T22:52:38-04:00 Eliminate headFS, use unconsFS instead A small step towards #22185 to avoid partial functions + safe implementation of `startsWithUnderscore`. - - - - - 5a535172 by Sebastian Graf at 2022-09-29T17:04:20+02:00 Demand: Format Call SubDemands `Cn(sd)` as `C(n,sd)` (#22231) Justification in #22231. Short form: In a demand like `1C1(C1(L))` it was too easy to confuse which `1` belongs to which `C`. Now that should be more obvious. Fixes #22231 - - - - - ea0083bf by Bryan Richter at 2022-09-29T15:48:38-04:00 Revert "ci: enable parallel compression for xz" Combined wxth XZ_OPT=9, this blew the memory capacity of CI runners. This reverts commit a5f9c35f5831ef5108e87813a96eac62803852ab. - - - - - f5e8f493 by Sebastian Graf at 2022-09-30T18:42:13+02:00 Boxity: Don't update Boxity unless worker/wrapper follows (#21754) A small refactoring in our Core Opt pipeline and some new functions for transfering argument boxities from one signature to another to facilitate `Note [Don't change boxity without worker/wrapper]`. Fixes #21754. - - - - - 4baf7b1c by M Farkas-Dyck at 2022-09-30T17:45:47-04:00 Scrub various partiality involving empty lists. Avoids some uses of `head` and `tail`, and some panics when an argument is null. - - - - - 95ead839 by Alexis King at 2022-10-01T00:37:43-04:00 Fix a bug in continuation capture across multiple stack chunks - - - - - 22096652 by Bodigrim at 2022-10-01T00:38:22-04:00 Enforce internal invariant of OrdList and fix bugs in viewCons / viewSnoc `viewCons` used to ignore `Many` constructor completely, returning `VNothing`. `viewSnoc` violated internal invariant of `Many` being a non-empty list. - - - - - 48ab9ca5 by Nicolas Trangez at 2022-10-04T20:34:10-04:00 chore: extend `.editorconfig` for C files - - - - - b8df5c72 by Brandon Chinn at 2022-10-04T20:34:46-04:00 Fix docs for pattern synonyms - - - - - 463ffe02 by Oleg Grenrus at 2022-10-04T20:35:24-04:00 Use sameByteArray# in sameByteArray - - - - - fbe1e86e by Pierre Le Marre at 2022-10-05T15:58:43+02:00 Minor fixes following Unicode 15.0.0 update - Fix changelog for Unicode 15.0.0 - Fix the checksums of the downloaded Unicode files, in base's tool: "ucd2haskell". - - - - - 8a31d02e by Cheng Shao at 2022-10-05T20:40:41-04:00 rts: don't enforce aligned((8)) on 32-bit targets We simply need to align to the word size for pointer tagging to work. On 32-bit targets, aligned((8)) is wasteful. - - - - - 532de368 by Ryan Scott at 2022-10-06T07:45:46-04:00 Export symbolSing, SSymbol, and friends (CLC#85) This implements this Core Libraries Proposal: https://github.com/haskell/core-libraries-committee/issues/85 In particular, it: 1. Exposes the `symbolSing` method of `KnownSymbol`, 2. Exports the abstract `SSymbol` type used in `symbolSing`, and 3. Defines an API for interacting with `SSymbol`. This also makes corresponding changes for `natSing`/`KnownNat`/`SNat` and `charSing`/`KnownChar`/`SChar`. This fixes #15183 and addresses part (2) of #21568. - - - - - d83a92e6 by sheaf at 2022-10-07T07:36:30-04:00 Remove mention of make from README.md - - - - - 945e8e49 by Bodigrim at 2022-10-10T17:13:31-04:00 Add a newline before since pragma in Data.Array.Byte - - - - - 44fcdb04 by Vladislav Zavialov at 2022-10-10T17:14:06-04:00 Parser/PostProcess: rename failOp* functions There are three functions named failOp* in the parser: failOpNotEnabledImportQualifiedPost failOpImportQualifiedTwice failOpFewArgs Only the last one has anything to do with operators. The other two were named this way either by mistake or due to a misunderstanding of what "op" stands for. This small patch corrects this. - - - - - 96d32ff2 by Simon Peyton Jones at 2022-10-10T22:30:21+01:00 Make rewrite rules "win" over inlining If a rewrite rule and a rewrite rule compete in the simplifier, this patch makes sure that the rewrite rule "win". That is, in general a bit fragile, but it's a huge help when making specialisation work reliably, as #21851 and #22097 showed. The change is fairly straightforwad, and documented in Note [Rewrite rules and inlining] in GHC.Core.Opt.Simplify.Iteration. Compile-times change, up and down a bit -- in some cases because we get better specialisation. But the payoff (more reliable specialisation) is large. Metrics: compile_time/bytes allocated ----------------------------------------------- T10421(normal) +3.7% BAD T10421a(normal) +5.5% T13253(normal) +1.3% T14052(ghci) +1.8% T15304(normal) -1.4% T16577(normal) +3.1% BAD T17516(normal) +2.3% T17836(normal) -1.9% T18223(normal) -1.8% T8095(normal) -1.3% T9961(normal) +2.5% BAD geo. mean +0.0% minimum -1.9% maximum +5.5% Nofib results are (bytes allocated) +-------------------------------++----------+ | ||tsv (rel) | +===============================++==========+ | imaginary/paraffins || +0.27% | | imaginary/rfib || -0.04% | | real/anna || +0.02% | | real/fem || -0.04% | | real/fluid || +1.68% | | real/gamteb || -0.34% | | real/gg || +1.54% | | real/hidden || -0.01% | | real/hpg || -0.03% | | real/infer || -0.03% | | real/prolog || +0.02% | | real/veritas || -0.47% | | shootout/fannkuch-redux || -0.03% | | shootout/k-nucleotide || -0.02% | | shootout/n-body || -0.06% | | shootout/spectral-norm || -0.01% | | spectral/cryptarithm2 || +1.25% | | spectral/fibheaps || +18.33% | | spectral/last-piece || -0.34% | +===============================++==========+ | geom mean || +0.17% | There are extensive notes in !8897 about the regressions. Briefly * fibheaps: there was a very delicately balanced inlining that tipped over the wrong way after this change. * cryptarithm2 and paraffins are caused by #22274, which is a separate issue really. (I.e. the right fix is *not* to make inlining "win" over rules.) So I'm accepting these changes Metric Increase: T10421 T16577 T9961 - - - - - ed4b5885 by Joachim Breitner at 2022-10-10T23:16:11-04:00 Utils.JSON: do not escapeJsonString in ToJson String instance as `escapeJsonString` is used in `renderJSON`, so the `JSString` constructor is meant to carry the unescaped string. - - - - - fbb88740 by Matthew Pickering at 2022-10-11T12:48:45-04:00 Tidy implicit binds We want to put implicit binds into fat interface files, so the easiest thing to do seems to be to treat them uniformly with other binders. - - - - - e058b138 by Matthew Pickering at 2022-10-11T12:48:45-04:00 Interface Files with Core Definitions This commit adds three new flags * -fwrite-if-simplified-core: Writes the whole core program into an interface file * -fbyte-code-and-object-code: Generate both byte code and object code when compiling a file * -fprefer-byte-code: Prefer to use byte-code if it's available when running TH splices. The goal for including the core bindings in an interface file is to be able to restart the compiler pipeline at the point just after simplification and before code generation. Once compilation is restarted then code can be created for the byte code backend. This can significantly speed up start-times for projects in GHCi. HLS already implements its own version of these extended interface files for this reason. Preferring to use byte-code means that we can avoid some potentially expensive code generation steps (see #21700) * Producing object code is much slower than producing bytecode, and normally you need to compile with `-dynamic-too` to produce code in the static and dynamic way, the dynamic way just for Template Haskell execution when using a dynamically linked compiler. * Linking many large object files, which happens once per splice, can be quite expensive compared to linking bytecode. And you can get GHC to compile the necessary byte code so `-fprefer-byte-code` has access to it by using `-fbyte-code-and-object-code`. Fixes #21067 - - - - - 9789ea8e by Matthew Pickering at 2022-10-11T12:48:45-04:00 Teach -fno-code about -fprefer-byte-code This patch teachs the code generation logic of -fno-code about -fprefer-byte-code, so that if we need to generate code for a module which prefers byte code, then we generate byte code rather than object code. We keep track separately which modules need object code and which byte code and then enable the relevant code generation for each. Typically the option will be enabled globally so one of these sets should be empty and we will just turn on byte code or object code generation. We also fix the bug where we would generate code for a module which enables Template Haskell despite the fact it was unecessary. Fixes #22016 - - - - - caced757 by Simon Peyton Jones at 2022-10-11T12:49:21-04:00 Don't keep exit join points so much We were religiously keeping exit join points throughout, which had some bad effects (#21148, #22084). This MR does two things: * Arranges that exit join points are inhibited from inlining only in /one/ Simplifier pass (right after Exitification). See Note [Be selective about not-inlining exit join points] in GHC.Core.Opt.Exitify It's not a big deal, but it shaves 0.1% off compile times. * Inline used-once non-recursive join points very aggressively Given join j x = rhs in joinrec k y = ....j x.... where this is the only occurrence of `j`, we want to inline `j`. (Unless sm_keep_exits is on.) See Note [Inline used-once non-recursive join points] in GHC.Core.Opt.Simplify.Utils This is just a tidy-up really. It doesn't change allocation, but getting rid of a binding is always good. Very effect on nofib -- some up and down. - - - - - 284cf387 by Simon Peyton Jones at 2022-10-11T12:49:21-04:00 Make SpecConstr bale out less often When doing performance debugging on #22084 / !8901, I found that the algorithm in SpecConstr.decreaseSpecCount was so aggressive that if there were /more/ specialisations available for an outer function, that could more or less kill off specialisation for an /inner/ function. (An example was in nofib/spectral/fibheaps.) This patch makes it a bit more aggressive, by dividing by 2, rather than by the number of outer specialisations. This makes the program bigger, temporarily: T19695(normal) ghc/alloc +11.3% BAD because we get more specialisation. But lots of other programs compile a bit faster and the geometric mean in perf/compiler is 0.0%. Metric Increase: T19695 - - - - - 66af1399 by Cheng Shao at 2022-10-11T12:49:59-04:00 CmmToC: emit explicit tail calls when the C compiler supports it Clang 13+ supports annotating a return statement using the musttail attribute, which guarantees that it lowers to a tail call if compilation succeeds. This patch takes advantage of that feature for the unregisterised code generator. The configure script tests availability of the musttail attribute, if it's available, the Cmm tail calls will become C tail calls that avoids the mini interpreter trampoline overhead. Nothing is affected if the musttail attribute is not supported. Clang documentation: https://clang.llvm.org/docs/AttributeReference.html#musttail - - - - - 7f0decd5 by Matthew Pickering at 2022-10-11T12:50:40-04:00 Don't include BufPos in interface files Ticket #22162 pointed out that the build directory was leaking into the ABI hash of a module because the BufPos depended on the location of the build tree. BufPos is only used in GHC.Parser.PostProcess.Haddock, and the information doesn't need to be propagated outside the context of a module. Fixes #22162 - - - - - dce9f320 by Cheng Shao at 2022-10-11T12:51:19-04:00 CLabel: fix isInfoTableLabel isInfoTableLabel does not take Cmm info table into account. This patch is required for data section layout of wasm32 NCG to work. - - - - - da679f2e by Bodigrim at 2022-10-11T18:02:59-04:00 Extend documentation for Data.List, mostly wrt infinite lists - - - - - 9c099387 by jwaldmann at 2022-10-11T18:02:59-04:00 Expand comment for Data.List.permutations - - - - - d3863cb7 by Bodigrim at 2022-10-11T18:03:37-04:00 ByteArray# is unlifted, not unboxed - - - - - f6260e8b by Ben Gamari at 2022-10-11T23:45:10-04:00 rts: Add missing declaration of stg_noDuplicate - - - - - 69ccec2c by Ben Gamari at 2022-10-11T23:45:10-04:00 base: Move CString, CStringLen to GHC.Foreign - - - - - f6e8feb4 by Ben Gamari at 2022-10-11T23:45:10-04:00 base: Move IPE helpers to GHC.InfoProv - - - - - 866c736e by Ben Gamari at 2022-10-11T23:45:10-04:00 rts: Refactor IPE tracing support - - - - - 6b0d2022 by Ben Gamari at 2022-10-11T23:45:10-04:00 Refactor IPE initialization Here we refactor the representation of info table provenance information in object code to significantly reduce its size and link-time impact. Specifically, we deduplicate strings and represent them as 32-bit offsets into a common string table. In addition, we rework the registration logic to eliminate allocation from the registration path, which is run from a static initializer where things like allocation are technically undefined behavior (although it did previously seem to work). For similar reasons we eliminate lock usage from registration path, instead relying on atomic CAS. Closes #22077. - - - - - 9b572d54 by Ben Gamari at 2022-10-11T23:45:10-04:00 Separate IPE source file from span The source file name can very often be shared across many IPE entries whereas the source coordinates are generally unique. Separate the two to exploit sharing of the former. - - - - - 27978ceb by Krzysztof Gogolewski at 2022-10-11T23:45:46-04:00 Make Cmm Lint messages use dump style Lint errors indicate an internal error in GHC, so it makes sense to use it instead of the user style. This is consistent with Core Lint and STG Lint: https://gitlab.haskell.org/ghc/ghc/-/blob/22096652/compiler/GHC/Core/Lint.hs#L429 https://gitlab.haskell.org/ghc/ghc/-/blob/22096652/compiler/GHC/Stg/Lint.hs#L144 Fixes #22218. - - - - - 64a390d9 by Bryan Richter at 2022-10-12T09:52:51+03:00 Mark T7919 as fragile On x86_64-linux, T7919 timed out ~30 times during July 2022. And again ~30 times in September 2022. - - - - - 481467a5 by Ben Gamari at 2022-10-12T08:08:37-04:00 rts: Don't hint inlining of appendToRunQueue These hints have resulted in compile-time warnings due to failed inlinings for quite some time. Moreover, it's quite unlikely that inlining them is all that beneficial given that they are rather sizeable functions. Resolves #22280. - - - - - 81915089 by Curran McConnell at 2022-10-12T16:32:26-04:00 remove name shadowing - - - - - 626652f7 by Tamar Christina at 2022-10-12T16:33:13-04:00 winio: do not re-translate input when handle is uncooked - - - - - 5172789a by Charles Taylor at 2022-10-12T16:33:57-04:00 Unrestricted OverloadedLabels (#11671) Implements GHC proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0170-unrestricted-overloadedlabels.rst - - - - - ce293908 by Andreas Klebinger at 2022-10-13T05:58:19-04:00 Add a perf test for the generics code pattern from #21839. This code showed a strong shift between compile time (got worse) and run time (got a lot better) recently which is perfectly acceptable. However it wasn't clear why the compile time regression was happening initially so I'm adding this test to make it easier to track such changes in the future. - - - - - 78ab7afe by Ben Gamari at 2022-10-13T05:58:56-04:00 rts/linker: Consolidate initializer/finalizer handling Here we extend our treatment of initializer/finalizer priorities to include ELF and in so doing refactor things to share the implementation with PEi386. As well, I fix a subtle misconception of the ordering behavior for `.ctors`. Fixes #21847. - - - - - 44692713 by Ben Gamari at 2022-10-13T05:58:56-04:00 rts/linker: Add support for .fini sections - - - - - beebf546 by Simon Hengel at 2022-10-13T05:59:37-04:00 Update phases.rst (the name of the original source file is $1, not $2) - - - - - eda6c05e by Finley McIlwaine at 2022-10-13T06:00:17-04:00 Clearer error msg for newtype GADTs with defaulted kind When a newtype introduces GADT eq_specs due to a defaulted RuntimeRep, we detect this and print the error message with explicit kinds. This also refactors newtype type checking to use the new diagnostic infra. Fixes #21447 - - - - - 43ab435a by Pierre Le Marre at 2022-10-14T07:45:43-04:00 Add standard Unicode case predicates isUpperCase and isLowerCase. These predicates use the standard Unicode case properties and are more intuitive than isUpper and isLower. Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/90#issuecomment-1276649403. Fixes #14589 - - - - - aec5a443 by Bodigrim at 2022-10-14T07:46:21-04:00 Add type signatures in where-clause of Data.List.permutations The type of interleave' is very much revealing, otherwise it's extremely tough to decipher. - - - - - ee0deb80 by Ben Gamari at 2022-10-14T18:29:20-04:00 rts: Use pthread_setname_np correctly on Darwin As noted in #22206, pthread_setname_np on Darwin only supports setting the name of the calling thread. Consequently we must introduce a trampoline which first sets the thread name before entering the thread entrypoint. - - - - - 8eff62a4 by Ben Gamari at 2022-10-14T18:29:57-04:00 testsuite: Add test for #22282 This will complement mpickering's more general port of foundation's numerical testsuite, providing a test for the specific case found in #22282. - - - - - 62a55001 by Ben Gamari at 2022-10-14T18:29:57-04:00 ncg/aarch64: Fix sub-word sign extension yet again In adc7f108141a973b6dcb02a7836eed65d61230e8 we fixed a number of issues to do with sign extension in the AArch64 NCG found by ghc/test-primops>. However, this patch made a critical error, assuming that getSomeReg would allocate a fresh register for the result of its evaluation. However, this is not the case as `getSomeReg (CmmReg r) == r`. Consequently, any mutation of the register returned by `getSomeReg` may have unwanted side-effects on other expressions also mentioning `r`. In the fix listed above, this manifested as the registers containing the operands of binary arithmetic operations being incorrectly sign-extended. This resulted in #22282. Sadly, the rather simple structure of the tests generated by `test-primops` meant that this particular case was not exercised. Even more surprisingly, none of our testsuite caught this case. Here we fix this by ensuring that intermediate sign extension is performed in a fresh register. Fixes #22282. - - - - - 54e41b16 by Teo Camarasu at 2022-10-15T18:09:24+01:00 rts: ensure we are below maxHeapSize after returning megablocks When the heap is heavily block fragmented the live byte size might be low while the memory usage is high. We want to ensure that heap overflow triggers in these cases. We do so by checking that we can return enough megablocks to under maxHeapSize at the end of GC. - - - - - 29bb90db by Teo Camarasu at 2022-10-15T18:09:24+01:00 rts: trigger a major collection if megablock usage exceeds maxHeapSize When the heap is suffering from block fragmentation, live bytes might be low while megablock usage is high. If megablock usage exceeds maxHeapSize, we want to trigger a major GC to try to recover some memory otherwise we will die from a heapOverflow at the end of the GC. Fixes #21927 - - - - - 4a4641ca by Teo Camarasu at 2022-10-15T18:11:29+01:00 Add realease note for #21927 - - - - - c1e5719a by Sebastian Graf at 2022-10-17T11:58:46-04:00 DmdAnal: Look through unfoldings of DataCon wrappers (#22241) Previously, the demand signature we computed upfront for a DataCon wrapper lacked boxity information and was much less precise than the demand transformer for the DataCon worker. In this patch we adopt the solution to look through unfoldings of DataCon wrappers during Demand Analysis, but still attach a demand signature for other passes such as the Simplifier. See `Note [DmdAnal for DataCon wrappers]` for more details. Fixes #22241. - - - - - 8c72411d by Gergo ERDI at 2022-10-17T19:20:04-04:00 Add `Enum (Down a)` instance that swaps `succ` and `pred` See https://github.com/haskell/core-libraries-committee/issues/51 for discussion. The key points driving the implementation are the following two ideas: * For the `Int` type, `comparing (complement @Int)` behaves exactly as an order-swapping `compare @Int`. * `enumFrom @(Down a)` can be implemented in terms of `enumFromThen @a`, if only the corner case of starting at the very end is handled specially - - - - - d80ad2f4 by Alan Zimmerman at 2022-10-17T19:20:40-04:00 Update the check-exact infrastructure to match ghc-exactprint GHC tests the exact print annotations using the contents of utils/check-exact. The same functionality is provided via https://github.com/alanz/ghc-exactprint The latter was updated to ensure it works with all of the files on hackage when 9.2 was released, as well as updated to ensure users of the library could work properly (apply-refact, retrie, etc). This commit brings the changes from ghc-exactprint into GHC/utils/check-exact, adapting for the changes to master. Once it lands, it will form the basis for the 9.4 version of ghc-exactprint. See also discussion around this process at #21355 - - - - - 08ab5419 by Andreas Klebinger at 2022-10-17T19:21:15-04:00 Avoid allocating intermediate lists for non recursive bindings. We do so by having an explicit folding function that doesn't need to allocate intermediate lists first. Fixes #22196 - - - - - ff6275ef by Andreas Klebinger at 2022-10-17T19:21:52-04:00 Testsuite: Add a new tables_next_to_code predicate. And use it to avoid T21710a failing on non-tntc archs. Fixes #22169 - - - - - abb82f38 by Eric Lindblad at 2022-10-17T19:22:33-04:00 example rewrite - - - - - 39beb801 by Eric Lindblad at 2022-10-17T19:22:33-04:00 remove redirect - - - - - 0d9fb651 by Eric Lindblad at 2022-10-17T19:22:33-04:00 use heredoc - - - - - 0fa2d185 by Matthew Pickering at 2022-10-17T19:23:10-04:00 testsuite: Fix typo when setting llvm_ways Since 2014 llvm_ways has been set to [] so none of the tests which use only_ways(llvm_ways) have worked as expected. Hopefully the tests still pass with this typo fix! - - - - - ced664a2 by Krzysztof Gogolewski at 2022-10-17T19:23:10-04:00 Fix T15155l not getting -fllvm - - - - - 0ac60423 by Andreas Klebinger at 2022-10-18T03:34:47-04:00 Fix GHCis interaction with tag inference. I had assumed that wrappers were not inlined in interactive mode. Meaning we would always execute the compiled wrapper which properly takes care of upholding the strict field invariant. This turned out to be wrong. So instead we now run tag inference even when we generate bytecode. In that case only for correctness not performance reasons although it will be still beneficial for runtime in some cases. I further fixed a bug where GHCi didn't tag nullary constructors properly when used as arguments. Which caused segfaults when calling into compiled functions which expect the strict field invariant to be upheld. Fixes #22042 and #21083 ------------------------- Metric Increase: T4801 Metric Decrease: T13035 ------------------------- - - - - - 9ecd1ac0 by M Farkas-Dyck at 2022-10-18T03:35:38-04:00 Make `Functor` a superclass of `TrieMap`, which lets us derive the `map` functions. - - - - - f60244d7 by Ben Gamari at 2022-10-18T03:36:15-04:00 configure: Bump minimum bootstrap GHC version Fixes #22245 - - - - - ba4bd4a4 by Matthew Pickering at 2022-10-18T03:36:55-04:00 Build System: Remove out-of-date comment about make build system Both make and hadrian interleave compilation of modules of different modules and don't respect the package boundaries. Therefore I just remove this comment which points out this "difference". Fixes #22253 - - - - - e1bbd368 by Matthew Pickering at 2022-10-18T16:15:49+02:00 Allow configuration of error message printing This MR implements the idea of #21731 that the printing of a diagnostic method should be configurable at the printing time. The interface of the `Diagnostic` class is modified from: ``` class Diagnostic a where diagnosticMessage :: a -> DecoratedSDoc diagnosticReason :: a -> DiagnosticReason diagnosticHints :: a -> [GhcHint] ``` to ``` class Diagnostic a where type DiagnosticOpts a defaultDiagnosticOpts :: DiagnosticOpts a diagnosticMessage :: DiagnosticOpts a -> a -> DecoratedSDoc diagnosticReason :: a -> DiagnosticReason diagnosticHints :: a -> [GhcHint] ``` and so each `Diagnostic` can implement their own configuration record which can then be supplied by a client in order to dictate how to print out the error message. At the moment this only allows us to implement #21722 nicely but in future it is more natural to separate the configuration of how much information we put into an error message and how much we decide to print out of it. Updates Haddock submodule - - - - - 99dc3e3d by Matthew Pickering at 2022-10-18T16:15:53+02:00 Add -fsuppress-error-contexts to disable printing error contexts in errors In many development environments, the source span is the primary means of seeing what an error message relates to, and the In the expression: and In an equation for: clauses are not particularly relevant. However, they can grow to be quite long, which can make the message itself both feel overwhelming and interact badly with limited-space areas. It's simple to implement this flag so we might as well do it and give the user control about how they see their messages. Fixes #21722 - - - - - 5b3a992f by Dai at 2022-10-19T10:45:45-04:00 Add VecSlot for unboxed sums of SIMD vectors This patch adds the missing `VecRep` case to `primRepSlot` function and all the necessary machinery to carry this new `VecSlot` through code generation. This allows programs involving unboxed sums of SIMD vectors to be written and compiled. Fixes #22187 - - - - - 6d7d9181 by sheaf at 2022-10-19T10:45:45-04:00 Remove SIMD conversions This patch makes it so that packing/unpacking SIMD vectors always uses the right sized types, e.g. unpacking a Word16X4# will give a tuple of Word16#s. As a result, we can get rid of the conversion instructions that were previously required. Fixes #22296 - - - - - 3be48877 by sheaf at 2022-10-19T10:45:45-04:00 Cmm Lint: relax SIMD register assignment check As noted in #22297, SIMD vector registers can be used to store different kinds of values, e.g. xmm1 can be used both to store integer and floating point values. The Cmm type system doesn't properly account for this, so we weaken the Cmm register assignment lint check to only compare widths when comparing a vector type with its allocated vector register. - - - - - f7b7a312 by sheaf at 2022-10-19T10:45:45-04:00 Disable some SIMD tests on non-X86 architectures - - - - - 83638dce by M Farkas-Dyck at 2022-10-19T10:46:29-04:00 Scrub various partiality involving lists (again). Lets us avoid some use of `head` and `tail`, and some panics. - - - - - c3732c62 by M Farkas-Dyck at 2022-10-19T10:47:13-04:00 Enforce invariant of `ListBag` constructor. - - - - - 488d3631 by Bodigrim at 2022-10-19T10:47:52-04:00 More precise types for fields of OverlappingInstances and UnsafeOverlap in TcSolverReportMsg It's clear from asserts in `GHC.Tc.Errors` that `overlappingInstances_matches` and `unsafeOverlapped` are supposed to be non-empty, and `unsafeOverlap_matches` contains a single instance, but these invariants are immediately lost afterwards and not encoded in types. This patch enforces the invariants by pattern matching and makes types more precise, avoiding asserts and partial functions such as `head`. - - - - - 607ce263 by sheaf at 2022-10-19T10:47:52-04:00 Rename unsafeOverlap_matches -> unsafeOverlap_match in UnsafeOverlap - - - - - 1fab9598 by Matthew Pickering at 2022-10-19T10:48:29-04:00 Add SpliceTypes test for hie files This test checks that typed splices and quotes get the right type information when used in hiefiles. See #21619 - - - - - a8b52786 by Jan Hrček at 2022-10-19T10:49:09-04:00 Small language fixes in 'Using GHC' - - - - - 1dab1167 by Gergő Érdi at 2022-10-19T10:49:51-04:00 Fix typo in `Opt_WriteIfSimplifiedCore`'s name - - - - - b17cfc9c by sheaf at 2022-10-19T10:50:37-04:00 TyEq:N assertion: only for saturated applications The assertion that checked TyEq:N in canEqCanLHSFinish incorrectly triggered in the case of an unsaturated newtype TyCon heading the RHS, even though we can't unwrap such an application. Now, we only trigger an assertion failure in case of a saturated application of a newtype TyCon. Fixes #22310 - - - - - ff6f2228 by M Farkas-Dyck at 2022-10-20T16:15:51-04:00 CoreToStg: purge `DynFlags`. - - - - - 1ebd521f by Matthew Pickering at 2022-10-20T16:16:27-04:00 ci: Make fat014 test robust For some reason I implemented this as a makefile test rather than a ghci_script test. Hopefully making it a ghci_script test makes it more robust. Fixes #22313 - - - - - 8cd6f435 by Curran McConnell at 2022-10-21T02:58:01-04:00 remove a no-warn directive from GHC.Cmm.ContFlowOpt This patch is motivated by the desire to remove the {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} directive at the top of GHC.Cmm.ContFlowOpt. (Based on the text in this coding standards doc, I understand it's a goal of the project to remove such directives.) I chose this task because I'm a new contributor to GHC, and it seemed like a good way to get acquainted with the patching process. In order to address the warning that arose when I removed the no-warn directive, I added a case to removeUnreachableBlocksProc to handle the CmmData constructor. Clearly, since this partial function has not been erroring out in the wild, its inputs are always in practice wrapped by the CmmProc constructor. Therefore the CmmData case is handled by a precise panic (which is an improvement over the partial pattern match from before). - - - - - a2af7c4c by Nicolas Trangez at 2022-10-21T02:58:39-04:00 build: get rid of `HAVE_TIME_H` As advertized by `autoreconf`: > All current systems provide time.h; it need not be checked for. Hence, remove the check for it in `configure.ac` and remove conditional inclusion of the header in `HAVE_TIME_H` blocks where applicable. The `time.h` header was being included in various source files without a `HAVE_TIME_H` guard already anyway. - - - - - 25cdc630 by Nicolas Trangez at 2022-10-21T02:58:39-04:00 rts: remove use of `TIME_WITH_SYS_TIME` `autoreconf` will insert an `m4_warning` when the obsolescent `AC_HEADER_TIME` macro is used: > Update your code to rely only on HAVE_SYS_TIME_H, > then remove this warning and the obsolete code below it. > All current systems provide time.h; it need not be checked for. > Not all systems provide sys/time.h, but those that do, all allow > you to include it and time.h simultaneously. Presence of `sys/time.h` was already checked in an earlier `AC_CHECK_HEADERS` invocation, so `AC_HEADER_TIME` can be dropped and guards relying on `TIME_WITH_SYS_TIME` can be reworked to (unconditionally) include `time.h` and include `sys/time.h` based on `HAVE_SYS_TIME_H`. Note the documentation of `AC_HEADER_TIME` in (at least) Autoconf 2.67 says > This macro is obsolescent, as current systems can include both files > when they exist. New programs need not use this macro. - - - - - 1fe7921c by Eric Lindblad at 2022-10-21T02:59:21-04:00 runhaskell - - - - - e3b3986e by David Feuer at 2022-10-21T03:00:00-04:00 Document how to quote certain names with spaces Quoting a name for Template Haskell is a bit tricky if the second character of that name is a single quote. The User's Guide falsely claimed that it was impossible. Document how to do it. Fixes #22236 - - - - - 0eba81e8 by Krzysztof Gogolewski at 2022-10-21T03:00:00-04:00 Fix syntax - - - - - a4dbd102 by Ben Gamari at 2022-10-21T09:11:12-04:00 Fix manifest filename when writing Windows .rc files As noted in #12971, we previously used `show` which resulted in inappropriate escaping of non-ASCII characters. - - - - - 30f0d9a9 by Ben Gamari at 2022-10-21T09:11:12-04:00 Write response files in UTF-8 on Windows This reverts the workaround introduced in f63c8ef33ec9666688163abe4ccf2d6c0428a7e7, which taught our response file logic to write response files with the `latin1` encoding to workaround `gcc`'s lacking Unicode support. This is now no longer necessary (and in fact actively unhelpful) since we rather use Clang. - - - - - b8304648 by M Farkas-Dyck at 2022-10-21T09:11:56-04:00 Scrub some partiality in `GHC.Core.Opt.Simplify.Utils`. - - - - - 09ec7de2 by Teo Camarasu at 2022-10-21T13:23:07-04:00 template-haskell: Improve documentation of strictness annotation types Before it was undocumentated that DecidedLazy can be returned by reifyConStrictness for strict fields. This can happen when a field has an unlifted type or its the single field of a newtype constructor. Fixes #21380 - - - - - 88172069 by M Farkas-Dyck at 2022-10-21T13:23:51-04:00 Delete `eqExpr`, since GHC 9.4 has been released. - - - - - 86e6549e by Ömer Sinan Ağacan at 2022-10-22T07:41:30-04:00 Introduce a standard thunk for allocating strings Currently for a top-level closure in the form hey = unpackCString# x we generate code like this: Main.hey_entry() // [R1] { info_tbls: [(c2T4, label: Main.hey_info rep: HeapRep static { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset c2T4: // global _rqm::P64 = R1; if ((Sp + 8) - 24 < SpLim) (likely: False) goto c2T5; else goto c2T6; c2T5: // global R1 = _rqm::P64; call (stg_gc_enter_1)(R1) args: 8, res: 0, upd: 8; c2T6: // global (_c2T1::I64) = call "ccall" arg hints: [PtrHint, PtrHint] result hints: [PtrHint] newCAF(BaseReg, _rqm::P64); if (_c2T1::I64 == 0) goto c2T3; else goto c2T2; c2T3: // global call (I64[_rqm::P64])() args: 8, res: 0, upd: 8; c2T2: // global I64[Sp - 16] = stg_bh_upd_frame_info; I64[Sp - 8] = _c2T1::I64; R2 = hey1_r2Gg_bytes; Sp = Sp - 16; call GHC.CString.unpackCString#_info(R2) args: 24, res: 0, upd: 24; } } This code is generated for every string literal. Only difference between top-level closures like this is the argument for the bytes of the string (hey1_r2Gg_bytes in the code above). With this patch we introduce a standard thunk in the RTS, called stg_MK_STRING_info, that does what `unpackCString# x` does, except it gets the bytes address from the payload. Using this, for the closure above, we generate this: Main.hey_closure" { Main.hey_closure: const stg_MK_STRING_info; const 0; // padding for indirectee const 0; // static link const 0; // saved info const hey1_r1Gg_bytes; // the payload } This is much smaller in code. Metric Decrease: T10421 T11195 T12150 T12425 T16577 T18282 T18698a T18698b Co-Authored By: Ben Gamari <ben at well-typed.com> - - - - - 1937016b by Andreas Klebinger at 2022-10-22T07:42:06-04:00 hadrian: Improve error for wrong key/value errors. - - - - - 11fe42d8 by Vladislav Zavialov at 2022-10-23T00:11:50+03:00 Class layout info (#19623) Updates the haddock submodule. - - - - - f0a90c11 by Sven Tennie at 2022-10-24T00:12:51-04:00 Pin used way for test cloneMyStack (#21977) cloneMyStack checks the order of closures on the cloned stack. This may change for different ways. Thus we limit this test to one way (normal). - - - - - 0614e74d by Aaron Allen at 2022-10-24T17:11:21+02:00 Convert Diagnostics in GHC.Tc.Gen.Splice (#20116) Replaces uses of `TcRnUnknownMessage` in `GHC.Tc.Gen.Splice` with structured diagnostics. closes #20116 - - - - - 8d2dbe2d by Andreas Klebinger at 2022-10-24T15:59:41-04:00 Improve stg lint for unboxed sums. It now properly lints cases where sums end up distributed over multiple args after unarise. Fixes #22026. - - - - - 41406da5 by Simon Peyton Jones at 2022-10-25T18:07:03-04:00 Fix binder-swap bug This patch fixes #21229 properly, by avoiding doing a binder-swap on dictionary Ids. This is pretty subtle, and explained in Note [Care with binder-swap on dictionaries]. Test is already in simplCore/should_run/T21229 This allows us to restore a feature to the specialiser that we had to revert: see Note [Specialising polymorphic dictionaries]. (This is done in a separate patch.) I also modularised things, using a new function scrutBinderSwap_maybe in all the places where we are (effectively) doing a binder-swap, notably * Simplify.Iteration.addAltUnfoldings * SpecConstr.extendCaseBndrs In Simplify.Iteration.addAltUnfoldings I also eliminated a guard Many <- idMult case_bndr because we concluded, in #22123, that it was doing no good. - - - - - 5a997e16 by Simon Peyton Jones at 2022-10-25T18:07:03-04:00 Make the specialiser handle polymorphic specialisation Ticket #13873 unexpectedly showed that a SPECIALISE pragma made a program run (a lot) slower, because less specialisation took place overall. It turned out that the specialiser was missing opportunities because of quantified type variables. It was quite easy to fix. The story is given in Note [Specialising polymorphic dictionaries] Two other minor fixes in the specialiser * There is no benefit in specialising data constructor /wrappers/. (They can appear overloaded because they are given a dictionary to store in the constructor.) Small guard in canSpecImport. * There was a buglet in the UnspecArg case of specHeader, in the case where there is a dead binder. We need a LitRubbish filler for the specUnfolding stuff. I expanded Note [Drop dead args from specialisations] to explain. There is a 4% increase in compile time for T15164, because we generate more specialised code. This seems OK. Metric Increase: T15164 - - - - - 7f203d00 by Sylvain Henry at 2022-10-25T18:07:43-04:00 Numeric exceptions: replace FFI calls with primops ghc-bignum needs a way to raise numerical exceptions defined in base package. At the time we used FFI calls into primops defined in the RTS. These FFI calls had to be wrapped into hacky bottoming functions because "foreign import prim" syntax doesn't support giving a bottoming demand to the foreign call (cf #16929). These hacky wrapper functions trip up the JavaScript backend (#21078) because they are polymorphic in their return type. This commit replaces them with primops very similar to raise# but raising predefined exceptions. - - - - - 0988a23d by Sylvain Henry at 2022-10-25T18:08:24-04:00 Enable popcount rewrite rule when cross-compiling The comment applies only when host's word size < target's word size. So we can relax the guard. - - - - - a2f53ac8 by Sylvain Henry at 2022-10-25T18:09:05-04:00 Add GHC.SysTools.Cpp module Move doCpp out of the driver to be able to use it in the upcoming JS backend. - - - - - 1fd7f201 by Ben Gamari at 2022-10-25T18:09:42-04:00 llvm-targets: Add datalayouts for big-endian AArch64 targets Fixes #22311. Thanks to @zeldin for the patch. - - - - - f5a486eb by Krzysztof Gogolewski at 2022-10-25T18:10:19-04:00 Cleanup String/FastString conversions Remove unused mkPtrString and isUnderscoreFS. We no longer use mkPtrString since 1d03d8bef96. Remove unnecessary conversions between FastString and String and back. - - - - - f7bfb40c by Ryan Scott at 2022-10-26T00:01:24-04:00 Broaden the in-scope sets for liftEnvSubst and composeTCvSubst This patch fixes two distinct (but closely related) buglets that were uncovered in #22235: * `liftEnvSubst` used an empty in-scope set, which was not wide enough to cover the variables in the range of the substitution. This patch fixes this by populating the in-scope set from the free variables in the range of the substitution. * `composeTCvSubst` applied the first substitution argument to the range of the second substitution argument, but the first substitution's in-scope set was not wide enough to cover the range of the second substutition. We similarly fix this issue in this patch by widening the first substitution's in-scope set before applying it. Fixes #22235. - - - - - 0270cc54 by Vladislav Zavialov at 2022-10-26T00:02:01-04:00 Introduce TcRnWithHsDocContext (#22346) Before this patch, GHC used withHsDocContext to attach an HsDocContext to an error message: addErr $ mkTcRnUnknownMessage $ mkPlainError noHints (withHsDocContext ctxt msg) The problem with this approach is that it only works with TcRnUnknownMessage. But could we attach an HsDocContext to a structured error message in a generic way? This patch solves the problem by introducing a new constructor to TcRnMessage: data TcRnMessage where ... TcRnWithHsDocContext :: !HsDocContext -> !TcRnMessage -> TcRnMessage ... - - - - - 9ab31f42 by Sylvain Henry at 2022-10-26T09:32:20+02:00 Testsuite: more precise test options Necessary for newer cross-compiling backends (JS, Wasm) that don't support TH yet. - - - - - f60a1a62 by Vladislav Zavialov at 2022-10-26T12:17:14-04:00 Use TcRnVDQInTermType in noNestedForallsContextsErr (#20115) When faced with VDQ in the type of a term, GHC generates the following error message: Illegal visible, dependent quantification in the type of a term (GHC does not yet support this) Prior to this patch, there were two ways this message could have been generated and represented: 1. with the dedicated constructor TcRnVDQInTermType (see check_type in GHC.Tc.Validity) 2. with the transitional constructor TcRnUnknownMessage (see noNestedForallsContextsErr in GHC.Rename.Utils) Not only this led to duplication of code generating the final SDoc, it also made it tricky to track the origin of the error message. This patch fixes the problem by using TcRnVDQInTermType exclusively. - - - - - 223e159d by Owen Shepherd at 2022-10-27T13:54:33-04:00 Remove source location information from interface files This change aims to minimize source location information leaking into interface files, which makes ABI hashes dependent on the build location. The `Binary (Located a)` instance has been removed completely. It seems that the HIE interface still needs the ability to serialize SrcSpans, but by wrapping the instances, it should be a lot more difficult to inadvertently add source location information. - - - - - 22e3deb9 by Simon Peyton Jones at 2022-10-27T13:55:37-04:00 Add missing dict binds to specialiser I had forgotten to add the auxiliary dict bindings to the /unfolding/ of a specialised function. This caused #22358, which reports failures when compiling Hackage packages fixed-vector indexed-traversable Regression test T22357 is snarfed from indexed-traversable - - - - - a8ed36f9 by Evan Relf at 2022-10-27T13:56:36-04:00 Fix broken link to `async` package - - - - - 750846cd by Zubin Duggal at 2022-10-28T00:49:22-04:00 Pass correct package db when testing stage1. It used to pick the db for stage-2 which obviously didn't work. - - - - - ad612f55 by Krzysztof Gogolewski at 2022-10-28T00:50:00-04:00 Minor SDoc-related cleanup * Rename pprCLabel to pprCLabelStyle, and use the name pprCLabel for a function using CStyle (analogous to pprAsmLabel) * Move LabelStyle to the CLabel module, it no longer needs to be in Outputable. * Move calls to 'text' right next to literals, to make sure the text/str rule is triggered. * Remove FastString/String roundtrip in Tc.Deriv.Generate * Introduce showSDocForUser', which abstracts over a pattern in GHCi.UI - - - - - c2872f3f by Bryan Richter at 2022-10-28T11:36:34+03:00 CI: Don't run lint-submods on nightly Fixes #22325 - - - - - 270037fa by Hécate Moonlight at 2022-10-28T19:46:12-04:00 Start the deprecation process for GHC.Pack - - - - - d45d8cb3 by M Farkas-Dyck at 2022-11-01T12:47:21-04:00 Drop a kludge for binutils<2.17, which is now over 10 years old. - - - - - 8ee8b418 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: `name` argument of `createOSThread` can be `const` Since we don't intend to ever change the incoming string, declare this to be true. Also, in the POSIX implementation, the argument is no longer `STG_UNUSED` (since ee0deb8054da2a597fc5624469b4c44fd769ada2) in any code path. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2#note_460080 - - - - - 13b5f102 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: fix lifetime of `start_thread`s `name` value Since, unlike the code in ee0deb8054da2^, usage of the `name` value passed to `createOSThread` now outlives said function's lifetime, and could hence be released by the caller by the time the new thread runs `start_thread`, it needs to be copied. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2#note_460080 See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9066 - - - - - edd175c9 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: fix OS thread naming in ticker Since ee0deb805, the use of `pthread_setname_np` on Darwin was fixed when invoking `createOSThread`. However, the 'ticker' has some thread-creation code which doesn't rely on `createOSThread`, yet also uses `pthread_setname_np`. This patch enforces all thread creation to go through a single function, which uses the (correct) thread-naming code introduced in ee0deb805. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2 See: https://gitlab.haskell.org/ghc/ghc/-/issues/22206 See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9066 - - - - - b7a00113 by Krzysztof Gogolewski at 2022-11-01T12:48:35-04:00 Typo: rename -fwrite-if-simplfied-core to -fwrite-if-simplified-core - - - - - 30e625e6 by Vladislav Zavialov at 2022-11-01T12:49:10-04:00 ThToHs: fix overzealous parenthesization Before this patch, when converting from TH.Exp to LHsExpr GhcPs, the compiler inserted more parentheses than required: ((f a) (b + c)) d This was happening because the LHS of the function application was parenthesized as if it was the RHS. Now we use funPrec and appPrec appropriately and produce sensibly parenthesized expressions: f a (b + c) d I also took the opportunity to remove the special case for LamE, which was not special at all and simply duplicated code. - - - - - 0560821f by Simon Peyton Jones at 2022-11-01T12:49:47-04:00 Add accurate skolem info when quantifying Ticket #22379 revealed that skolemiseQuantifiedTyVar was dropping the passed-in skol_info on the floor when it encountered a SkolemTv. Bad! Several TyCons thereby share a single SkolemInfo on their binders, which lead to bogus error reports. - - - - - 38d19668 by Fendor at 2022-11-01T12:50:25-04:00 Expose UnitEnvGraphKey for user-code - - - - - 77e24902 by Simon Peyton Jones at 2022-11-01T12:51:00-04:00 Shrink test case for #22357 Ryan Scott offered a cut-down repro case (60 lines instead of more than 700 lines) - - - - - 4521f649 by Simon Peyton Jones at 2022-11-01T12:51:00-04:00 Add two tests for #17366 - - - - - 6b400d26 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_NORETURN` Instead of sprinkling the codebase with `GNU(C3)_ATTRIBUTE(__noreturn__)`, add a `STG_NORETURN` macro (for, basically, the same thing) similar to `STG_UNUSED` and others, and update the code to use this macro where applicable. - - - - - f9638654 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: consistently use `STG_UNUSED` - - - - - 81a58433 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_USED` Similar to `STG_UNUSED`, have a specific macro for `__attribute__(used)`. - - - - - 41e1f748 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_MALLOC` Instead of using `GNUC3_ATTRIBUTE(__malloc__)`, provide a `STG_MALLOC` macro definition and use it instead. - - - - - 3a9a8bde by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: use `STG_UNUSED` - - - - - 9ab999de by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: specify deallocator of allocating functions This patch adds a new `STG_MALLOC1` macro (and its counterpart `STG_MALLOC2` for completeness) which allows to specify the deallocation function to be used with allocations of allocating functions, and applies it to `stg*allocBytes`. It also fixes a case where `free` was used to free up an `stgMallocBytes` allocation, found by the above change. See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-malloc-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - 81c0c7c9 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: use `alloc_size` attribute This patch adds the `STG_ALLOC_SIZE1` and `STG_ALLOC_SIZE2` macros which allow to set the `alloc_size` attribute on functions, when available. See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-alloc_005fsize-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - 99a1d896 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: add and use `STG_RETURNS_NONNULL` See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-returns_005fnonnull-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - c235b399 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: tag `stgStrndup` as `STG_MALLOC` See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - ed81b448 by Oleg Grenrus at 2022-11-02T12:07:27-04:00 Move Symbol implementation note out of public haddock - - - - - 284fd39c by Ben Gamari at 2022-11-03T01:58:54-04:00 gen-dll: Drop it Currently it is only used by the make build system, which is soon to be retired, and it has not built since 41cf758b. We may need to reintroduce it when dynamic-linking support is introduced on Windows, but we will cross that bridge once we get there. Fixes #21753. - - - - - 24f4f54f by Matthew Pickering at 2022-11-03T01:59:30-04:00 Port foundation numeric tests to GHC testsuite This commit ports the numeric tests which found a regression in GHC-9.4. https://github.com/haskell-foundation/foundation/issues/571 Included in the commit is a simple random number generator and simplified QuickCheck implementation. In future these could be factored out of this standalone file and reused as a general purpose library which could be used for other QuickCheck style tests in the testsuite. See #22282 - - - - - d51bf7bd by M Farkas-Dyck at 2022-11-03T02:00:13-04:00 git: ignore HIE files. Cleans up git status if one sets -fwrite-ide-info in hadrian/ghci. - - - - - a9fc15b1 by Matthew Pickering at 2022-11-03T02:00:49-04:00 Clarify status of bindings in WholeCoreBindings Gergo points out that these bindings are tidied, rather than prepd as the variable claims. Therefore we update the name of the variable to reflect reality and add a comment to the data type to try to erase any future confusion. Fixes #22307 - - - - - 634da448 by Bodigrim at 2022-11-03T21:25:02+00:00 Fix haddocks for GHC.IORef - - - - - 31125154 by Andreas Klebinger at 2022-11-03T23:08:09-04:00 Export pprTrace and friends from GHC.Prelude. Introduces GHC.Prelude.Basic which can be used in modules which are a dependency of the ppr code. - - - - - bdc8cbb3 by Bryan Richter at 2022-11-04T10:27:37+02:00 CI: Allow hadrian-ghc-in-ghci to run in nightlies Since lint-submods doesn't run in nightlies, hadrian-ghc-in-ghci needs to mark it as "optional" so it can run if the job doesn't exist. Fixes #22396. - - - - - 3c0e3793 by Krzysztof Gogolewski at 2022-11-05T00:29:57-04:00 Minor refactor around FastStrings Pass FastStrings to functions directly, to make sure the rule for fsLit "literal" fires. Remove SDoc indirection in GHCi.UI.Tags and GHC.Unit.Module.Graph. - - - - - e41b2f55 by Matthew Pickering at 2022-11-05T14:18:10+00:00 Bump unix submodule to 2.8.0.0 Also bumps process and ghc-boot bounds on unix. For hadrian, when cross-compiling, we add -Wwarn=unused-imports -Wwarn=unused-top-binds to validation flavour. Further fixes in unix and/or hsc2hs is needed to make it completely free of warnings; for the time being, this change is needed to unblock other cross-compilation related work. - - - - - 42938a58 by Matthew Pickering at 2022-11-05T14:18:10+00:00 Bump Win32 submodule to 2.13.4.0 Fixes #22098 - - - - - e7372bc5 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump ci-images revision ci-images has recently been updated, including changes needed for wasm32-wasi CI. - - - - - 88cb9492 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump gmp-tarballs submodule Includes a fix for wasm support, doesn't impact other targets. - - - - - 69427ce9 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump haskeline submodule Includes a fix for wasm support, doesn't impact other targets. - - - - - 5fe11fe6 by Carter Schonwald at 2022-11-07T13:22:14-05:00 bump llvm upper bound - - - - - 68f49874 by M Farkas-Dyck at 2022-11-08T12:53:55-05:00 Define `Infinite` list and use where appropriate. Also add perf test for infinite list fusion. In particular, in `GHC.Core`, often we deal with infinite lists of roles. Also in a few locations we deal with infinite lists of names. Thanks to simonpj for helping to write the Note [Fusion for `Infinite` lists]. - - - - - ce726cd2 by Ross Paterson at 2022-11-08T12:54:34-05:00 Fix TypeData issues (fixes #22315 and #22332) There were two bugs here: 1. Treating type-level constructors as PromotedDataCon doesn't always work, in particular because constructors promoted via DataKinds are called both T and 'T. (Tests T22332a, T22332b, T22315a, T22315b) Fix: guard these cases with isDataKindsPromotedDataCon. 2. Type-level constructors were sent to the code generator, producing things like constructor wrappers. (Tests T22332a, T22332b) Fix: test for them in isDataTyCon. Other changes: * changed the marking of "type data" DataCon's as suggested by SPJ. * added a test TDGADT for a type-level GADT. * comment tweaks * change tcIfaceTyCon to ignore IfaceTyConInfo, so that IfaceTyConInfo is used only for pretty printing, not for typechecking. (SPJ) - - - - - 132f8908 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Clarify msum/asum documentation - - - - - bb5888c5 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Add example for (<$) - - - - - 080fffa1 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Document what Alternative/MonadPlus instances actually do - - - - - 92ccb8de by Giles Anderson at 2022-11-09T09:27:52-05:00 Use TcRnDiagnostic in GHC.Tc.TyCl.Instance (#20117) The following `TcRnDiagnostic` messages have been introduced: TcRnWarnUnsatisfiedMinimalDefinition TcRnMisplacedInstSig TcRnBadBootFamInstDeclErr TcRnIllegalFamilyInstance TcRnAssocInClassErr TcRnBadFamInstDecl TcRnNotOpenFamily - - - - - 90c5abd4 by Hécate Moonlight at 2022-11-09T09:28:30-05:00 GHCi tags generation phase 2 see #19884 - - - - - f9f17b68 by Simon Peyton Jones at 2022-11-10T12:20:03+00:00 Fire RULES in the Specialiser The Specialiser has, for some time, fires class-op RULES in the specialiser itself: see Note [Specialisation modulo dictionary selectors] This MR beefs it up a bit, so that it fires /all/ RULES in the specialiser, not just class-op rules. See Note [Fire rules in the specialiser] The result is a bit more specialisation; see test simplCore/should_compile/T21851_2 This pushed me into a bit of refactoring. I made a new data types GHC.Core.Rules.RuleEnv, which combines - the several source of rules (local, home-package, external) - the orphan-module dependencies in a single record for `getRules` to consult. That drove a bunch of follow-on refactoring, including allowing me to remove cr_visible_orphan_mods from the CoreReader data type. I moved some of the RuleBase/RuleEnv stuff into GHC.Core.Rule. The reorganisation in the Simplifier improve compile times a bit (geom mean -0.1%), but T9961 is an outlier Metric Decrease: T9961 - - - - - 2b3d0bee by Simon Peyton Jones at 2022-11-10T12:21:13+00:00 Make indexError work better The problem here is described at some length in Note [Boxity for bottoming functions] and Note [Reboxed crud for bottoming calls] in GHC.Core.Opt.DmdAnal. This patch adds a SPECIALISE pragma for indexError, which makes it much less vulnerable to the problem described in these Notes. (This came up in another line of work, where a small change made indexError do reboxing (in nofib/spectral/simple/table_sort) that didn't happen before my change. I've opened #22404 to document the fagility. - - - - - 399e921b by Simon Peyton Jones at 2022-11-10T12:21:14+00:00 Fix DsUselessSpecialiseForClassMethodSelector msg The error message for DsUselessSpecialiseForClassMethodSelector was just wrong (a typo in some earlier work); trivial fix - - - - - dac0682a by Sebastian Graf at 2022-11-10T21:16:01-05:00 WorkWrap: Unboxing unboxed tuples is not always useful (#22388) See Note [Unboxing through unboxed tuples]. Fixes #22388. - - - - - 1230c268 by Sebastian Graf at 2022-11-10T21:16:01-05:00 Boxity: Handle argument budget of unboxed tuples correctly (#21737) Now Budget roughly tracks the combined width of all arguments after unarisation. See the changes to `Note [Worker argument budgets]`. Fixes #21737. - - - - - 2829fd92 by Cheng Shao at 2022-11-11T00:26:54-05:00 autoconf: check getpid getuid raise This patch adds checks for getpid, getuid and raise in autoconf. These functions are absent in wasm32-wasi and thus needs to be checked. - - - - - f5dfd1b4 by Cheng Shao at 2022-11-11T00:26:55-05:00 hadrian: add -Wwarn only for cross-compiling unix - - - - - 2e6ab453 by Cheng Shao at 2022-11-11T00:26:55-05:00 hadrian: add targetSupportsThreadedRts flag This patch adds a targetSupportsThreadedRts flag to indicate whether the target supports the threaded rts at all, different from existing targetSupportsSMP that checks whether -N is supported by the RTS. All existing flavours have also been updated accordingly to respect this flags. Some targets (e.g. wasm32-wasi) does not support the threaded rts, therefore this flag is needed for the default flavours to work. It makes more sense to have proper autoconf logic to check for threading support, but for the time being, we just set the flag to False iff the target is wasm32. - - - - - 8104f6f5 by Cheng Shao at 2022-11-11T00:26:55-05:00 Fix Cmm symbol kind - - - - - b2035823 by Norman Ramsey at 2022-11-11T00:26:55-05:00 add the two key graph modules from Martin Erwig's FGL Martin Erwig's FGL (Functional Graph Library) provides an "inductive" representation of graphs. A general graph has labeled nodes and labeled edges. The key operation on a graph is to decompose it by removing one node, together with the edges that connect the node to the rest of the graph. There is also an inverse composition operation. The decomposition and composition operations make this representation of graphs exceptionally well suited to implement graph algorithms in which the graph is continually changing, as alluded to in #21259. This commit adds `GHC.Data.Graph.Inductive.Graph`, which defines the interface, and `GHC.Data.Graph.Inductive.PatriciaTree`, which provides an implementation. Both modules are taken from `fgl-5.7.0.3` on Hackage, with these changes: - Copyright and license text have been copied into the files themselves, not stored separately. - Some calls to `error` have been replaced with calls to `panic`. - Conditional-compilation support for older versions of GHC, `containers`, and `base` has been removed. - - - - - 3633a5f5 by Norman Ramsey at 2022-11-11T00:26:55-05:00 add new modules for reducibility and WebAssembly translation - - - - - df7bfef8 by Cheng Shao at 2022-11-11T00:26:55-05:00 Add support for the wasm32-wasi target tuple This patch adds the wasm32-wasi tuple support to various places in the tree: autoconf, hadrian, ghc-boot and also the compiler. The codegen logic will come in subsequent commits. - - - - - 32ae62e6 by Cheng Shao at 2022-11-11T00:26:55-05:00 deriveConstants: parse .ll output for wasm32 due to broken nm This patch makes deriveConstants emit and parse an .ll file when targeting wasm. It's a necessary workaround for broken llvm-nm on wasm, which isn't capable of reporting correct constant values when parsing an object. - - - - - 07e92c92 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: workaround cmm's improper variadic ccall breaking wasm32 typechecking Unlike other targets, wasm requires the function signature of the call site and callee to strictly match. So in Cmm, when we call a C function that actually returns a value, we need to add an _unused local variable to receive it, otherwise type error awaits. An even bigger problem is calling variadic functions like barf() and such. Cmm doesn't support CAPI calling convention yet, so calls to variadic functions just happen to work in some cases with some target's ABI. But again, it doesn't work with wasm. Fortunately, the wasm C ABI lowers varargs to a stack pointer argument, and it can be passed NULL when no other arguments are expected to be passed. So we also add the additional unused NULL arguments to those functions, so to fix wasm, while not affecting behavior on other targets. - - - - - 00124d12 by Cheng Shao at 2022-11-11T00:26:55-05:00 testsuite: correct sleep() signature in T5611 In libc, sleep() returns an integer. The ccall type signature should match the libc definition, otherwise it causes linker error on wasm. - - - - - d72466a9 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: prefer ffi_type_void over FFI_TYPE_VOID This patch uses ffi_type_void instead of FFI_TYPE_VOID in the interpreter code, since the FFI_TYPE_* macros are not available in libffi-wasm32 yet. The libffi public documentation also only mentions the lower-case ffi_type_* symbols, so we should prefer the lower-case API here. - - - - - 4d36a1d3 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: don't define RTS_USER_SIGNALS when signal.h is not present In the rts, we have a RTS_USER_SIGNALS macro, and most signal-related logic is guarded with RTS_USER_SIGNALS. This patch extends the range of code guarded with RTS_USER_SIGNALS, and define RTS_USER_SIGNALS iff signal.h is actually detected by autoconf. This is required for wasm32-wasi to work, which lacks signals. - - - - - 3f1e164f by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: use HAVE_GETPID to guard subprocess related logic We've previously added detection of getpid() in autoconf. This patch uses HAVE_GETPID to guard some subprocess related logic in the RTS. This is required for certain targets like wasm32-wasi, where there isn't a process model at all. - - - - - 50bf5e77 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: IPE.c: don't do mutex stuff when THREADED_RTS is not defined This patch adds the missing THREADED_RTS CPP guard to mutex logic in IPE.c. - - - - - ed3b3da0 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: genericRaise: use exit() instead when not HAVE_RAISE We check existence of raise() in autoconf, and here, if not HAVE_RAISE, we should use exit() instead in genericRaise. - - - - - c0ba1547 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: checkSuid: don't do it when not HAVE_GETUID When getuid() is not present, don't do checkSuid since it doesn't make sense anyway on that target. - - - - - d2d6dfd2 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: wasm32 placeholder linker This patch adds minimal placeholder linker logic for wasm32, just enough to unblock compiling rts on wasm32. RTS linker functionality is not properly implemented yet for wasm32. - - - - - 65ba3285 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsStartup: chdir to PWD on wasm32 This patch adds a wasm32-specific behavior to RtsStartup logic. When the PWD environment variable is present, we chdir() to it first. The point is to workaround an issue in wasi-libc: it's currently not possible to specify the initial working directory, it always defaults to / (in the virtual filesystem mapped from some host directory). For some use cases this is sufficient, but there are some other cases (e.g. in the testsuite) where the program needs to access files outside. - - - - - 65b82542 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: no timer for wasm32 Due to the lack of threads, on wasm32 there can't be a background timer that periodically resets the context switch flag. This patch disables timer for wasm32, and also makes the scheduler default to -C0 on wasm32 to avoid starving threads. - - - - - e007586f by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsSymbols: empty RTS_POSIX_ONLY_SYMBOLS for wasm32 The default RTS_POSIX_ONLY_SYMBOLS doesn't make sense on wasm32. - - - - - 0e33f667 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: Schedule: no FORKPROCESS_PRIMOP_SUPPORTED on wasm32 On wasm32 there isn't a process model at all, so no FORKPROCESS_PRIMOP_SUPPORTED. - - - - - 88bbdb31 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: LibffiAdjustor: adapt to ffi_alloc_prep_closure interface for wasm32 libffi-wasm32 only supports non-standard libffi closure api via ffi_alloc_prep_closure(). This patch implements ffi_alloc_prep_closure() via standard libffi closure api on other targets, and uses it to implement adjustor functionality. - - - - - 15138746 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: don't return memory to OS on wasm32 This patch makes the storage manager not return any memory on wasm32. The detailed reason is described in Note [Megablock allocator on wasm]. - - - - - 631af3cc by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: make flushExec a no-op on wasm32 This patch makes flushExec a no-op on wasm32, since there's no such thing as executable memory on wasm32 in the first place. - - - - - 654a3d46 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsStartup: don't call resetTerminalSettings, freeThreadingResources on wasm32 This patch prevents resetTerminalSettings and freeThreadingResources to be called on wasm32, since there is no TTY or threading on wasm32 at all. - - - - - f271e7ca by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: OSThreads.h: stub types for wasm32 This patch defines stub Condition/Mutex/OSThreadId/ThreadLocalKey types for wasm32, just enough to unblock compiling RTS. Any threading-related functionality has been patched to be disabled on wasm32. - - - - - a6ac67b0 by Cheng Shao at 2022-11-11T00:26:55-05:00 Add register mapping for wasm32 This patch adds register mapping logic for wasm32. See Note [Register mapping on WebAssembly] in wasm32 NCG for more description. - - - - - d7b33982 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: wasm32 specific logic This patch adds the rest of wasm32 specific logic in rts. - - - - - 7f59b0f3 by Cheng Shao at 2022-11-11T00:26:55-05:00 base: fall back to using monotonic clock to emulate cputime on wasm32 On wasm32, we have to fall back to using monotonic clock to emulate cputime, since there's no native support for cputime as a clock id. - - - - - 5fcbae0b by Cheng Shao at 2022-11-11T00:26:55-05:00 base: more autoconf checks for wasm32 This patch adds more autoconf checks to base, since those functions and headers may exist on other POSIX systems but don't exist on wasm32. - - - - - 00a9359f by Cheng Shao at 2022-11-11T00:26:55-05:00 base: avoid using unsupported posix functionality on wasm32 This base patch avoids using unsupported posix functionality on wasm32. - - - - - 34b8f611 by Cheng Shao at 2022-11-11T00:26:55-05:00 autoconf: set CrossCompiling=YES in cross bindist configure This patch fixes the bindist autoconf logic to properly set CrossCompiling=YES when it's a cross GHC bindist. - - - - - 5ebeaa45 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: add util functions for UniqFM and UniqMap This patch adds addToUFM_L (backed by insertLookupWithKey), addToUniqMap_L and intersectUniqMap_C. These UniqFM/UniqMap util functions are used by the wasm32 NCG. - - - - - 177c56c1 by Cheng Shao at 2022-11-11T00:26:55-05:00 driver: avoid -Wl,--no-as-needed for wasm32 The driver used to pass -Wl,--no-as-needed for LLD linking. This is actually only supported for ELF targets, and must be avoided when linking for wasm32. - - - - - 06f01c74 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: allow big arith for wasm32 This patch enables Cmm big arithmetic on wasm32, since 64-bit arithmetic can be efficiently lowered to wasm32 opcodes. - - - - - df6bb112 by Cheng Shao at 2022-11-11T00:26:55-05:00 driver: pass -Wa,--no-type-check for wasm32 when runAsPhase This patch passes -Wa,--no-type-check for wasm32 when compiling assembly. See the added note for more detailed explanation. - - - - - c1fe4ab6 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: enforce cmm switch planning for wasm32 This patch forcibly enable Cmm switch planning for wasm32, since otherwise the switch tables we generate may exceed the br_table maximum allowed size. - - - - - a8adc71e by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: annotate CmmFileEmbed with blob length This patch adds the blob length field to CmmFileEmbed. The wasm32 NCG needs to know the precise size of each data segment. - - - - - 36340328 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: wasm32 NCG This patch adds the wasm32 NCG. - - - - - 435f42ea by Cheng Shao at 2022-11-11T00:26:55-05:00 ci: add wasm32-wasi release bindist job - - - - - d8262fdc by Cheng Shao at 2022-11-11T00:26:55-05:00 ci: add a stronger test for cross bindists This commit adds a simple GHC API program that parses and reprints the original hello world program used for basic testing of cross bindists. Before there's full cross-compilation support in the test suite driver, this provides better coverage than the original test. - - - - - 8e6ae882 by Cheng Shao at 2022-11-11T00:26:55-05:00 CODEOWNERS: add wasm-specific maintainers - - - - - 707d5651 by Zubin Duggal at 2022-11-11T00:27:31-05:00 Clarify that LLVM upper bound is non-inclusive during configure (#22411) - - - - - 430eccef by Ben Gamari at 2022-11-11T13:16:45-05:00 rts: Check for program_invocation_short_name via autoconf Instead of assuming support on all Linuxes. - - - - - 6dab0046 by Matthew Pickering at 2022-11-11T13:17:22-05:00 driver: Fix -fdefer-diagnostics flag The `withDeferredDiagnostics` wrapper wasn't doing anything because the session it was modifying wasn't used in hsc_env. Therefore the fix is simple, just push the `getSession` call into the scope of `withDeferredDiagnostics`. Fixes #22391 - - - - - d0c691b6 by Simon Peyton Jones at 2022-11-11T13:18:07-05:00 Add a fast path for data constructor workers See Note [Fast path for data constructors] in GHC.Core.Opt.Simplify.Iteration This bypasses lots of expensive logic, in the special case of applications of data constructors. It is a surprisingly worthwhile improvement, as you can see in the figures below. Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Read(normal) -2.0% CoOpt_Singletons(normal) -2.0% ManyConstructors(normal) -1.3% T10421(normal) -1.9% GOOD T10421a(normal) -1.5% T10858(normal) -1.6% T11545(normal) -1.7% T12234(optasm) -1.3% T12425(optasm) -1.9% GOOD T13035(normal) -1.0% GOOD T13056(optasm) -1.8% T13253(normal) -3.3% GOOD T15164(normal) -1.7% T15304(normal) -3.4% T15630(normal) -2.8% T16577(normal) -4.3% GOOD T17096(normal) -1.1% T17516(normal) -3.1% T18282(normal) -1.9% T18304(normal) -1.2% T18698a(normal) -1.2% GOOD T18698b(normal) -1.5% GOOD T18923(normal) -1.3% T1969(normal) -1.3% GOOD T19695(normal) -4.4% GOOD T21839c(normal) -2.7% GOOD T21839r(normal) -2.7% GOOD T4801(normal) -3.8% GOOD T5642(normal) -3.1% GOOD T6048(optasm) -2.5% GOOD T9020(optasm) -2.7% GOOD T9630(normal) -2.1% GOOD T9961(normal) -11.7% GOOD WWRec(normal) -1.0% geo. mean -1.1% minimum -11.7% maximum +0.1% Metric Decrease: T10421 T12425 T13035 T13253 T16577 T18698a T18698b T1969 T19695 T21839c T21839r T4801 T5642 T6048 T9020 T9630 T9961 - - - - - 3c37d30b by Krzysztof Gogolewski at 2022-11-11T19:18:39+01:00 Use a more efficient printer for code generation (#21853) The changes in `GHC.Utils.Outputable` are the bulk of the patch and drive the rest. The types `HLine` and `HDoc` in Outputable can be used instead of `SDoc` and support printing directly to a handle with `bPutHDoc`. See Note [SDoc versus HDoc] and Note [HLine versus HDoc]. The classes `IsLine` and `IsDoc` are used to make the existing code polymorphic over `HLine`/`HDoc` and `SDoc`. This is done for X86, PPC, AArch64, DWARF and dependencies (printing module names, labels etc.). Co-authored-by: Alexis King <lexi.lambda at gmail.com> Metric Decrease: CoOpt_Read ManyAlternatives ManyConstructors T10421 T12425 T12707 T13035 T13056 T13253 T13379 T18140 T18282 T18698a T18698b T1969 T20049 T21839c T21839r T3064 T3294 T4801 T5321FD T5321Fun T5631 T6048 T783 T9198 T9233 - - - - - 6b92b47f by Matthew Craven at 2022-11-11T18:32:14-05:00 Weaken wrinkle 1 of Note [Scrutinee Constant Folding] Fixes #22375. Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 154c70f6 by Simon Peyton Jones at 2022-11-11T23:40:10+00:00 Fix fragile RULE setup in GHC.Float In testing my type-vs-constraint patch I found that the handling of Natural literals was very fragile -- and I somehow tripped that fragility in my work. So this patch fixes the fragility. See Note [realToFrac natural-to-float] This made a big (9%) difference in one existing test in perf/should_run/T1-359 Metric Decrease: T10359 - - - - - 778c6adc by Simon Peyton Jones at 2022-11-11T23:40:10+00:00 Type vs Constraint: finally nailed This big patch addresses the rats-nest of issues that have plagued us for years, about the relationship between Type and Constraint. See #11715/#21623. The main payload of the patch is: * To introduce CONSTRAINT :: RuntimeRep -> Type * To make TYPE and CONSTRAINT distinct throughout the compiler Two overview Notes in GHC.Builtin.Types.Prim * Note [TYPE and CONSTRAINT] * Note [Type and Constraint are not apart] This is the main complication. The specifics * New primitive types (GHC.Builtin.Types.Prim) - CONSTRAINT - ctArrowTyCon (=>) - tcArrowTyCon (-=>) - ccArrowTyCon (==>) - funTyCon FUN -- Not new See Note [Function type constructors and FunTy] and Note [TYPE and CONSTRAINT] * GHC.Builtin.Types: - New type Constraint = CONSTRAINT LiftedRep - I also stopped nonEmptyTyCon being built-in; it only needs to be wired-in * Exploit the fact that Type and Constraint are distinct throughout GHC - Get rid of tcView in favour of coreView. - Many tcXX functions become XX functions. e.g. tcGetCastedTyVar --> getCastedTyVar * Kill off Note [ForAllTy and typechecker equality], in (old) GHC.Tc.Solver.Canonical. It said that typechecker-equality should ignore the specified/inferred distinction when comparein two ForAllTys. But that wsa only weakly supported and (worse) implies that we need a separate typechecker equality, different from core equality. No no no. * GHC.Core.TyCon: kill off FunTyCon in data TyCon. There was no need for it, and anyway now we have four of them! * GHC.Core.TyCo.Rep: add two FunTyFlags to FunCo See Note [FunCo] in that module. * GHC.Core.Type. Lots and lots of changes driven by adding CONSTRAINT. The key new function is sORTKind_maybe; most other changes are built on top of that. See also `funTyConAppTy_maybe` and `tyConAppFun_maybe`. * Fix a longstanding bug in GHC.Core.Type.typeKind, and Core Lint, in kinding ForAllTys. See new tules (FORALL1) and (FORALL2) in GHC.Core.Type. (The bug was that before (forall (cv::t1 ~# t2). blah), where blah::TYPE IntRep, would get kind (TYPE IntRep), but it should be (TYPE LiftedRep). See Note [Kinding rules for types] in GHC.Core.Type. * GHC.Core.TyCo.Compare is a new module in which we do eqType and cmpType. Of course, no tcEqType any more. * GHC.Core.TyCo.FVs. I moved some free-var-like function into this module: tyConsOfType, visVarsOfType, and occCheckExpand. Refactoring only. * GHC.Builtin.Types. Compiletely re-engineer boxingDataCon_maybe to have one for each /RuntimeRep/, rather than one for each /Type/. This dramatically widens the range of types we can auto-box. See Note [Boxing constructors] in GHC.Builtin.Types The boxing types themselves are declared in library ghc-prim:GHC.Types. GHC.Core.Make. Re-engineer the treatment of "big" tuples (mkBigCoreVarTup etc) GHC.Core.Make, so that it auto-boxes unboxed values and (crucially) types of kind Constraint. That allows the desugaring for arrows to work; it gathers up free variables (including dictionaries) into tuples. See Note [Big tuples] in GHC.Core.Make. There is still work to do here: #22336. But things are better than before. * GHC.Core.Make. We need two absent-error Ids, aBSENT_ERROR_ID for types of kind Type, and aBSENT_CONSTRAINT_ERROR_ID for vaues of kind Constraint. Ditto noInlineId vs noInlieConstraintId in GHC.Types.Id.Make; see Note [inlineId magic]. * GHC.Core.TyCo.Rep. Completely refactor the NthCo coercion. It is now called SelCo, and its fields are much more descriptive than the single Int we used to have. A great improvement. See Note [SelCo] in GHC.Core.TyCo.Rep. * GHC.Core.RoughMap.roughMatchTyConName. Collapse TYPE and CONSTRAINT to a single TyCon, so that the rough-map does not distinguish them. * GHC.Core.DataCon - Mainly just improve documentation * Some significant renamings: GHC.Core.Multiplicity: Many --> ManyTy (easier to grep for) One --> OneTy GHC.Core.TyCo.Rep TyCoBinder --> GHC.Core.Var.PiTyBinder GHC.Core.Var TyCoVarBinder --> ForAllTyBinder AnonArgFlag --> FunTyFlag ArgFlag --> ForAllTyFlag GHC.Core.TyCon TyConTyCoBinder --> TyConPiTyBinder Many functions are renamed in consequence e.g. isinvisibleArgFlag becomes isInvisibleForAllTyFlag, etc * I refactored FunTyFlag (was AnonArgFlag) into a simple, flat data type data FunTyFlag = FTF_T_T -- (->) Type -> Type | FTF_T_C -- (-=>) Type -> Constraint | FTF_C_T -- (=>) Constraint -> Type | FTF_C_C -- (==>) Constraint -> Constraint * GHC.Tc.Errors.Ppr. Some significant refactoring in the TypeEqMisMatch case of pprMismatchMsg. * I made the tyConUnique field of TyCon strict, because I saw code with lots of silly eval's. That revealed that GHC.Settings.Constants.mAX_SUM_SIZE can only be 63, because we pack the sum tag into a 6-bit field. (Lurking bug squashed.) Fixes * #21530 Updates haddock submodule slightly. Performance changes ~~~~~~~~~~~~~~~~~~~ I was worried that compile times would get worse, but after some careful profiling we are down to a geometric mean 0.1% increase in allocation (in perf/compiler). That seems fine. There is a big runtime improvement in T10359 Metric Decrease: LargeRecord MultiLayerModulesTH_OneShot T13386 T13719 Metric Increase: T8095 - - - - - 360f5fec by Simon Peyton Jones at 2022-11-11T23:40:11+00:00 Indent closing "#-}" to silence HLint - - - - - e160cf47 by Krzysztof Gogolewski at 2022-11-12T08:05:28-05:00 Fix merge conflict in T18355.stderr Fixes #22446 - - - - - 294f9073 by Simon Peyton Jones at 2022-11-12T23:14:13+00:00 Fix a trivial typo in dataConNonlinearType Fixes #22416 - - - - - 268a3ce9 by Ben Gamari at 2022-11-14T09:36:57-05:00 eventlog: Ensure that IPE output contains actual info table pointers The refactoring in 866c736e introduced a rather subtle change in the semantics of the IPE eventlog output, changing the eventlog field from encoding info table pointers to "TNTC pointers" (which point to entry code when tables-next-to-code is enabled). Fix this. Fixes #22452. - - - - - d91db679 by Matthew Pickering at 2022-11-14T16:48:10-05:00 testsuite: Add tests for T22347 These are fixed in recent versions but might as well add regression tests. See #22347 - - - - - 8f6c576b by Matthew Pickering at 2022-11-14T16:48:45-05:00 testsuite: Improve output from tests which have failing pre_cmd There are two changes: * If a pre_cmd fails, then don't attempt to run the test. * If a pre_cmd fails, then print the stdout and stderr from running that command (which hopefully has a nice error message). For example: ``` =====> 1 of 1 [0, 0, 0] *** framework failure for test-defaulting-plugin(normal) pre_cmd failed: 2 ** pre_cmd was "$MAKE -s --no-print-directory -C defaulting-plugin package.test-defaulting-plugin TOP={top}". stdout: stderr: DefaultLifted.hs:19:13: error: [GHC-76037] Not in scope: type constructor or class ‘Typ’ Suggested fix: Perhaps use one of these: ‘Type’ (imported from GHC.Tc.Utils.TcType), data constructor ‘Type’ (imported from GHC.Plugins) | 19 | instance Eq Typ where | ^^^ make: *** [Makefile:17: package.test-defaulting-plugin] Error 1 Performance Metrics (test environment: local): ``` Fixes #22329 - - - - - 2b7d5ccc by Madeline Haraj at 2022-11-14T22:44:17+00:00 Implement UNPACK support for sum types. This is based on osa's unpack_sums PR from ages past. The meat of the patch is implemented in dataConArgUnpackSum and described in Note [UNPACK for sum types]. - - - - - 78f7ecb0 by Andreas Klebinger at 2022-11-14T22:20:29-05:00 Expand on the need to clone local binders. Fixes #22402. - - - - - 65ce43cc by Krzysztof Gogolewski at 2022-11-14T22:21:05-05:00 Fix :i Constraint printing "type Constraint = Constraint" Since Constraint became a synonym for CONSTRAINT 'LiftedRep, we need the same code for handling printing as for the synonym Type = TYPE 'LiftedRep. This addresses the same bug as #18594, so I'm reusing the test. - - - - - 94549f8f by ARATA Mizuki at 2022-11-15T21:36:03-05:00 configure: Don't check for an unsupported version of LLVM The upper bound is not inclusive. Fixes #22449 - - - - - 02d3511b by Bodigrim at 2022-11-15T21:36:41-05:00 Fix capitalization in haddock for TestEquality - - - - - 08bf2881 by Cheng Shao at 2022-11-16T09:16:29+00:00 base: make Foreign.Marshal.Pool use RTS internal arena for allocation `Foreign.Marshal.Pool` used to call `malloc` once for each allocation request. Each `Pool` maintained a list of allocated pointers, and traverses the list to `free` each one of those pointers. The extra O(n) overhead is apparently bad for a `Pool` that serves a lot of small allocation requests. This patch uses the RTS internal arena to implement `Pool`, with these benefits: - Gets rid of the extra O(n) overhead. - The RTS arena is simply a bump allocator backed by the block allocator, each allocation request is likely faster than a libc `malloc` call. Closes #14762 #18338. - - - - - 37cfe3c0 by Krzysztof Gogolewski at 2022-11-16T14:50:06-05:00 Misc cleanup * Replace catMaybes . map f with mapMaybe f * Use concatFS to concatenate multiple FastStrings * Fix documentation of -exclude-module * Cleanup getIgnoreCount in GHCi.UI - - - - - b0ac3813 by Lawton Nichols at 2022-11-19T03:22:14-05:00 Give better errors for code corrupted by Unicode smart quotes (#21843) Previously, we emitted a generic and potentially confusing error during lexical analysis on programs containing smart quotes (“/”/‘/’). This commit adds smart quote-aware lexer errors. - - - - - cb8430f8 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Make OpaqueNo* tests less noisy to unrelated changes - - - - - b1a8af69 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Simplifier: Consider `seq` as a `BoringCtxt` (#22317) See `Note [Seq is boring]` for the rationale. Fixes #22317. - - - - - 9fd11585 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Make T21839c's ghc/max threshold more forgiving - - - - - 4b6251ab by Simon Peyton Jones at 2022-11-19T03:23:24-05:00 Be more careful when reporting unbound RULE binders See Note [Variables unbound on the LHS] in GHC.HsToCore.Binds. Fixes #22471. - - - - - e8f2b80d by Peter Trommler at 2022-11-19T03:23:59-05:00 PPC NCG: Fix generating assembler code Fixes #22479 - - - - - f2f9ef07 by Bodigrim at 2022-11-20T18:39:30-05:00 Extend documentation for Data.IORef - - - - - ef511b23 by Simon Peyton Jones at 2022-11-20T18:40:05-05:00 Buglet in GHC.Tc.Module.checkBootTyCon This lurking bug used the wrong function to compare two types in GHC.Tc.Module.checkBootTyCon It's hard to trigger the bug, which only came up during !9343, so there's no regression test in this MR. - - - - - 451aeac3 by Bodigrim at 2022-11-20T18:40:44-05:00 Add since pragmas for c_interruptible_open and hostIsThreaded - - - - - 8d6aaa49 by Duncan Coutts at 2022-11-22T02:06:16-05:00 Introduce CapIOManager as the per-cap I/O mangager state Rather than each I/O manager adding things into the Capability structure ad-hoc, we should have a common CapIOManager iomgr member of the Capability structure, with a common interface to initialise etc. The content of the CapIOManager struct will be defined differently for each I/O manager implementation. Eventually we should be able to have the CapIOManager be opaque to the rest of the RTS, and known just to the I/O manager implementation. We plan for that by making the Capability contain a pointer to the CapIOManager rather than containing the structure directly. Initially just move the Unix threaded I/O manager's control FD. - - - - - 8901285e by Duncan Coutts at 2022-11-22T02:06:17-05:00 Add hook markCapabilityIOManager To allow I/O managers to have GC roots in the Capability, within the CapIOManager structure. Not yet used in this patch. - - - - - 5cf709c5 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move APPEND_TO_BLOCKED_QUEUE from cmm to C The I/O and delay blocking primitives for the non-threaded way currently access the blocked_queue and sleeping_queue directly. We want to move where those queues are to make their ownership clearer: to have them clearly belong to the I/O manager impls rather than to the scheduler. Ultimately we will want to change their representation too. It's inconvenient to do that if these queues are accessed directly from cmm code. So as a first step, replace the APPEND_TO_BLOCKED_QUEUE with a C version appendToIOBlockedQueue(), and replace the open-coded sleeping_queue insertion with insertIntoSleepingQueue(). - - - - - ced9acdb by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move {blocked,sleeping}_queue from scheduler global vars to CapIOManager The blocked_queue_{hd,tl} and the sleeping_queue are currently cooperatively managed between the scheduler and (some but not all of) the non-threaded I/O manager implementations. They lived as global vars with the scheduler, but are poked by I/O primops and the I/O manager backends. This patch is a step on the path towards making the management of I/O or timer blocking belong to the I/O managers and not the scheduler. Specifically, this patch moves the {blocked,sleeping}_queue from being global vars in the scheduler to being members of the CapIOManager struct within each Capability. They are not yet exclusively used by the I/O managers: they are still poked from a couple other places, notably in the scheduler before calling awaitEvent. - - - - - 0f68919e by Duncan Coutts at 2022-11-22T02:06:17-05:00 Remove the now-unused markScheduler The global vars {blocked,sleeping}_queue are now in the Capability and so get marked there via markCapabilityIOManager. - - - - - 39a91f60 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move macros for checking for pending IO or timers from Schedule.h to Schedule.c and IOManager.h This is just moving, the next step will be to rejig them slightly. For the non-threaded RTS the scheduler needs to be able to test for there being pending I/O operation or pending timers. The implementation of these tests should really be considered to be part of the I/O managers and not part of the scheduler. - - - - - 664b034b by Duncan Coutts at 2022-11-22T02:06:17-05:00 Replace EMPTY_{BLOCKED,SLEEPING}_QUEUE macros by function These are the macros originaly from Scheduler.h, previously moved to IOManager.h, and now replaced with a single inline function anyPendingTimeoutsOrIO(). We can use a single function since the two macros were always checked together. Note that since anyPendingTimeoutsOrIO is defined for all IO manager cases, including threaded, we do not need to guard its use by cpp #if !defined(THREADED_RTS) - - - - - 32946220 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Expand emptyThreadQueues inline for clarity It was not really adding anything. The name no longer meant anything since those I/O and timeout queues do not belong to the scheuler. In one of the two places it was used, the comments already had to explain what it did, whereas now the code matches the comment nicely. - - - - - 9943baf9 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move the awaitEvent declaration into IOManager.h And add or adjust comments at the use sites of awaitEvent. - - - - - 054dcc9d by Duncan Coutts at 2022-11-22T02:06:17-05:00 Pass the Capability *cap explicitly to awaitEvent It is currently only used in the non-threaded RTS so it works to use MainCapability, but it's a bit nicer to pass the cap anyway. It's certainly shorter. - - - - - 667fe5a4 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Pass the Capability *cap explicitly to appendToIOBlockedQueue And to insertIntoSleepingQueue. Again, it's a bit cleaner and simpler though not strictly necessary given that these primops are currently only used in the non-threaded RTS. - - - - - 7181b074 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Reveiew feedback: improve one of the TODO comments The one about the nonsense (const False) test on WinIO for there being any IO or timers pending, leading to unnecessary complication later in the scheduler. - - - - - e5b68183 by Andreas Klebinger at 2022-11-22T02:06:52-05:00 Optimize getLevity. Avoid the intermediate data structures allocated by splitTyConApp. This avoids ~0.5% of allocations for a build using -O2. Fixes #22254 - - - - - de5fb348 by Andreas Klebinger at 2022-11-22T02:07:28-05:00 hadrian:Set TNTC when running testsuite. - - - - - 9d61c182 by Oleg Grenrus at 2022-11-22T15:59:34-05:00 Add unsafePtrEquality# restricted to UnliftedTypes - - - - - e817c871 by Jonathan Dowland at 2022-11-22T16:00:14-05:00 utils/unlit: adjust parser to match Report spec The Haskell 2010 Report says that, for Latex-style Literate format, "Program code begins on the first line following a line that begins \begin{code}". (This is unchanged from the 98 Report) However the unlit.c implementation only matches a line that contains "\begin{code}" and nothing else. One consequence of this is that one cannot suffix Latex options to the code environment. I.e., this does not work: \begin{code}[label=foo,caption=Foo Code] Adjust the matcher to conform to the specification from the Report. The Haskell Wiki currently recommends suffixing a '%' to \begin{code} in order to deliberately hide a code block from Haskell. This is bad advice, as it's relying on an implementation quirk rather than specified behaviour. None-the-less, some people have tried to use it, c.f. <https://mail.haskell.org/pipermail/haskell-cafe/2009-September/066780.html> An alternative solution is to define a separate, equivalent Latex environment to "code", that is functionally identical in Latex but ignored by unlit. This should not be a burden: users are required to manually define the code environment anyway, as it is not provided by the Latex verbatim or lstlistings packages usually used for presenting code in documents. Fixes #3549. - - - - - 0b7fef11 by Teo Camarasu at 2022-11-23T12:44:33-05:00 Fix eventlog all option Previously it didn't enable/disable nonmoving_gc and ticky event types Fixes #21813 - - - - - 04d0618c by Arnaud Spiwack at 2022-11-23T12:45:14-05:00 Expand Note [Linear types] with the stance on linting linearity Per the discussion on #22123 - - - - - e1538516 by Lawton Nichols at 2022-11-23T12:45:55-05:00 Add documentation on custom Prelude modules (#22228) Specifically, custom Prelude modules that are named `Prelude`. - - - - - b5c71454 by Sylvain Henry at 2022-11-23T12:46:35-05:00 Don't let configure perform trivial substitutions (#21846) Hadrian now performs substitutions, especially to generate .cabal files from .cabal.in files. Two benefits: 1. We won't have to re-configure when we modify thing.cabal.in. Hadrian will take care of this for us. 2. It paves the way to allow the same package to be configured differently by Hadrian in the same session. This will be useful to fix #19174: we want to build a stage2 cross-compiler for the host platform and a stage1 compiler for the cross target platform in the same Hadrian session. - - - - - 99aca26b by nineonine at 2022-11-23T12:47:11-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043) Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043 - - - - - 040bfdc3 by M Farkas-Dyck at 2022-11-23T21:59:03-05:00 Scrub some no-warning pragmas. - - - - - 178c1fd8 by Vladislav Zavialov at 2022-11-23T21:59:39-05:00 Check if the SDoc starts with a single quote (#22488) This patch fixes pretty-printing of character literals inside promoted lists and tuples. When we pretty-print a promoted list or tuple whose first element starts with a single quote, we want to add a space between the opening bracket and the element: '[True] -- ok '[ 'True] -- ok '['True] -- not ok If we don't add the space, we accidentally produce a character literal '['. Before this patch, pprSpaceIfPromotedTyCon inspected the type as an AST and tried to guess if it would be rendered with a single quote. However, it missed the case when the inner type was itself a character literal: '[ 'x'] -- ok '['x'] -- not ok Instead of adding this particular case, I opted for a more future-proof solution: check the SDoc directly. This way we can detect if the single quote is actually there instead of trying to predict it from the AST. The new function is called spaceIfSingleQuote. - - - - - 11627c42 by Matthew Pickering at 2022-11-23T22:00:15-05:00 notes: Fix references to HPT space leak note Updating this note was missed when updating the HPT to the HUG. Fixes #22477 - - - - - 86ff1523 by Andrei Borzenkov at 2022-11-24T17:24:51-05:00 Convert diagnostics in GHC.Rename.Expr to proper TcRnMessage (#20115) Problem: avoid usage of TcRnMessageUnknown Solution: The following `TcRnMessage` messages has been introduced: TcRnNoRebindableSyntaxRecordDot TcRnNoFieldPunsRecordDot TcRnIllegalStaticExpression TcRnIllegalStaticFormInSplice TcRnListComprehensionDuplicateBinding TcRnEmptyStmtsGroup TcRnLastStmtNotExpr TcRnUnexpectedStatementInContext TcRnIllegalTupleSection TcRnIllegalImplicitParameterBindings TcRnSectionWithoutParentheses Co-authored-by: sheaf <sam.derbyshire at gmail.com> - - - - - d198a19a by Cheng Shao at 2022-11-24T17:25:29-05:00 rts: fix missing Arena.h symbols in RtsSymbols.c It was an unfortunate oversight in !8961 and broke devel2 builds. - - - - - 5943e739 by Bodigrim at 2022-11-25T04:38:28-05:00 Assorted fixes to avoid Data.List.{head,tail} - - - - - 1f1b99b8 by sheaf at 2022-11-25T04:38:28-05:00 Review suggestions for assorted fixes to avoid Data.List.{head,tail} - - - - - 13d627bb by Vladislav Zavialov at 2022-11-25T04:39:04-05:00 Print unticked promoted data constructors (#20531) Before this patch, GHC unconditionally printed ticks before promoted data constructors: ghci> type T = True -- unticked (user-written) ghci> :kind! T T :: Bool = 'True -- ticked (compiler output) After this patch, GHC prints ticks only when necessary: ghci> type F = False -- unticked (user-written) ghci> :kind! F F :: Bool = False -- unticked (compiler output) ghci> data False -- introduce ambiguity ghci> :kind! F F :: Bool = 'False -- ticked by necessity (compiler output) The old behavior can be enabled by -fprint-redundant-promotion-ticks. Summary of changes: * Rename PrintUnqualified to NamePprCtx * Add QueryPromotionTick to it * Consult the GlobalRdrEnv to decide whether to print a tick (see mkPromTick) * Introduce -fprint-redundant-promotion-ticks Co-authored-by: Artyom Kuznetsov <hi at wzrd.ht> - - - - - d10dc6bd by Simon Peyton Jones at 2022-11-25T22:31:27+00:00 Fix decomposition of TyConApps Ticket #22331 showed that we were being too eager to decompose a Wanted TyConApp, leading to incompleteness in the solver. To understand all this I ended up doing a substantial rewrite of the old Note [Decomposing equalities], now reborn as Note [Decomposing TyConApp equalities]. Plus rewrites of other related Notes. The actual fix is very minor and actually simplifies the code: in `can_decompose` in `GHC.Tc.Solver.Canonical.canTyConApp`, we now call `noMatchableIrreds`. A closely related refactor: we stop trying to use the same "no matchable givens" function here as in `matchClassInst`. Instead split into two much simpler functions. - - - - - 2da5c38a by Will Hawkins at 2022-11-26T04:05:04-05:00 Redirect output of musttail attribute test Compilation output from test for support of musttail attribute leaked to the console. - - - - - 0eb1c331 by Cheng Shao at 2022-11-28T08:55:53+00:00 Move hs_mulIntMayOflo cbits to ghc-prim It's only used by wasm NCG at the moment, but ghc-prim is a more reasonable place for hosting out-of-line primops. Also, we only need a single version of hs_mulIntMayOflo. - - - - - 36b53a9d by Cheng Shao at 2022-11-28T09:05:57+00:00 compiler: generate ccalls for clz/ctz/popcnt in wasm NCG We used to generate a single wasm clz/ctz/popcnt opcode, but it's wrong when it comes to subwords, so might as well generate ccalls for them. See #22470 for details. - - - - - d4134e92 by Cheng Shao at 2022-11-28T23:48:14-05:00 compiler: remove unused MO_U_MulMayOflo We actually only emit MO_S_MulMayOflo and never emit MO_U_MulMayOflo anywhere. - - - - - 8d15eadc by Apoorv Ingle at 2022-11-29T03:09:31-05:00 Killing cc_fundeps, streamlining kind equality orientation, and type equality processing order Fixes: #217093 Associated to #19415 This change * Flips the orientation of the the generated kind equality coercion in canEqLHSHetero; * Removes `cc_fundeps` in CDictCan as the check was incomplete; * Changes `canDecomposableTyConAppOk` to ensure we process kind equalities before type equalities and avoiding a call to `canEqLHSHetero` while processing wanted TyConApp equalities * Adds 2 new tests for validating the change - testsuites/typecheck/should_compile/T21703.hs and - testsuites/typecheck/should_fail/T19415b.hs (a simpler version of T19415.hs) * Misc: Due to the change in the equality direction some error messages now have flipped type mismatch errors * Changes in Notes: - Note [Fundeps with instances, and equality orientation] supercedes Note [Fundeps with instances] - Added Note [Kind Equality Orientation] to visualize the kind flipping - Added Note [Decomposing Dependent TyCons and Processing Wanted Equalties] - - - - - 646969d4 by Krzysztof Gogolewski at 2022-11-29T03:10:13-05:00 Change printing of sized literals to match the proposal Literals in Core were printed as e.g. 0xFF#16 :: Int16#. The proposal 451 now specifies syntax 0xFF#Int16. This change affects the Core printer only - more to be done later. Part of #21422. - - - - - 02e282ec by Simon Peyton Jones at 2022-11-29T03:10:48-05:00 Be a bit more selective about floating bottoming expressions This MR arranges to float a bottoming expression to the top only if it escapes a value lambda. See #22494 and Note [Floating to the top] in SetLevels. This has a generally beneficial effect in nofib +-------------------------------++----------+ | ||tsv (rel) | +===============================++==========+ | imaginary/paraffins || -0.93% | | imaginary/rfib || -0.05% | | real/fem || -0.03% | | real/fluid || -0.01% | | real/fulsom || +0.05% | | real/gamteb || -0.27% | | real/gg || -0.10% | | real/hidden || -0.01% | | real/hpg || -0.03% | | real/scs || -11.13% | | shootout/k-nucleotide || -0.01% | | shootout/n-body || -0.08% | | shootout/reverse-complement || -0.00% | | shootout/spectral-norm || -0.02% | | spectral/fibheaps || -0.20% | | spectral/hartel/fft || -1.04% | | spectral/hartel/solid || +0.33% | | spectral/hartel/wave4main || -0.35% | | spectral/mate || +0.76% | +===============================++==========+ | geom mean || -0.12% | The effect on compile time is generally slightly beneficial Metrics: compile_time/bytes allocated ---------------------------------------------- MultiLayerModulesTH_OneShot(normal) +0.3% PmSeriesG(normal) -0.2% PmSeriesT(normal) -0.1% T10421(normal) -0.1% T10421a(normal) -0.1% T10858(normal) -0.1% T11276(normal) -0.1% T11303b(normal) -0.2% T11545(normal) -0.1% T11822(normal) -0.1% T12150(optasm) -0.1% T12234(optasm) -0.3% T13035(normal) -0.2% T16190(normal) -0.1% T16875(normal) -0.4% T17836b(normal) -0.2% T17977(normal) -0.2% T17977b(normal) -0.2% T18140(normal) -0.1% T18282(normal) -0.1% T18304(normal) -0.2% T18698a(normal) -0.1% T18923(normal) -0.1% T20049(normal) -0.1% T21839r(normal) -0.1% T5837(normal) -0.4% T6048(optasm) +3.2% BAD T9198(normal) -0.2% T9630(normal) -0.1% TcPlugin_RewritePerf(normal) -0.4% hard_hole_fits(normal) -0.1% geo. mean -0.0% minimum -0.4% maximum +3.2% The T6048 outlier is hard to pin down, but it may be the effect of reading in more interface files definitions. It's a small program for which compile time is very short, so I'm not bothered about it. Metric Increase: T6048 - - - - - ab23dc5e by Ben Gamari at 2022-11-29T03:11:25-05:00 testsuite: Mark unpack_sums_6 as fragile due to #22504 This test is explicitly dependent upon runtime, which is generally not appropriate given that the testsuite is run in parallel and generally saturates the CPU. - - - - - def47dd3 by Ben Gamari at 2022-11-29T03:11:25-05:00 testsuite: Don't use grep -q in unpack_sums_7 `grep -q` closes stdin as soon as it finds the pattern it is looking for, resulting in #22484. - - - - - cc25d52e by Sylvain Henry at 2022-11-29T09:44:31+01:00 Add Javascript backend Add JS backend adapted from the GHCJS project by Luite Stegeman. Some features haven't been ported or implemented yet. Tests for these features have been disabled with an associated gitlab ticket. Bump array submodule Work funded by IOG. Co-authored-by: Jeffrey Young <jeffrey.young at iohk.io> Co-authored-by: Luite Stegeman <stegeman at gmail.com> Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 68c966cd by sheaf at 2022-11-30T09:31:25-05:00 Fix @since annotations on WithDict and Coercible Fixes #22453 - - - - - a3a8e9e9 by Simon Peyton Jones at 2022-11-30T09:32:03-05:00 Be more careful in GHC.Tc.Solver.Interact.solveOneFromTheOther We were failing to account for the cc_pend_sc flag in this important function, with the result that we expanded superclasses forever. Fixes #22516. - - - - - a9d9b8c0 by Simon Peyton Jones at 2022-11-30T09:32:03-05:00 Use mkNakedFunTy in tcPatSynSig As #22521 showed, in tcPatSynSig we make a "fake type" to kind-generalise; and that type has unzonked type variables in it. So we must not use `mkFunTy` (which checks FunTy's invariants) via `mkPhiTy` when building this type. Instead we need to use `mkNakedFunTy`. Easy fix. - - - - - 31462d98 by Andreas Klebinger at 2022-11-30T14:50:58-05:00 Properly cast values when writing/reading unboxed sums. Unboxed sums might store a Int8# value as Int64#. This patch makes sure we keep track of the actual value type. See Note [Casting slot arguments] for the details. - - - - - 10a2a7de by Oleg Grenrus at 2022-11-30T14:51:39-05:00 Move Void to GHC.Base... This change would allow `Void` to be used deeper in module graph. For example exported from `Prelude` (though that might be already possible). Also this change includes a change `stimes @Void _ x = x`, https://github.com/haskell/core-libraries-committee/issues/95 While the above is not required, maintaining old stimes behavior would be tricky as `GHC.Base` doesn't know about `Num` or `Integral`, which would require more hs-boot files. - - - - - b4cfa8e2 by Sebastian Graf at 2022-11-30T14:52:24-05:00 DmdAnal: Reflect the `seq` of strict fields of a DataCon worker (#22475) See the updated `Note [Data-con worker strictness]` and the new `Note [Demand transformer for data constructors]`. Fixes #22475. - - - - - d87f28d8 by Baldur Blöndal at 2022-11-30T21:16:36+01:00 Make Functor a quantified superclass of Bifunctor. See https://github.com/haskell/core-libraries-committee/issues/91 for discussion. This change relates Bifunctor with Functor by requiring second = fmap. Moreover this change is a step towards unblocking the major version bump of bifunctors and profunctors to major version 6. This paves the way to move the Profunctor class into base. For that Functor first similarly becomes a superclass of Profunctor in the new major version 6. - - - - - 72cf4c5d by doyougnu at 2022-12-01T12:36:44-05:00 FastString: SAT bucket_match Metric Decrease: MultiLayerModulesTH_OneShot - - - - - afc2540d by Simon Peyton Jones at 2022-12-01T12:37:20-05:00 Add a missing varToCoreExpr in etaBodyForJoinPoint This subtle bug showed up when compiling a library with 9.4. See #22491. The bug is present in master, but it is hard to trigger; the new regression test T22491 fails in 9.4. The fix was easy: just add a missing varToCoreExpr in etaBodyForJoinPoint. The fix is definitely right though! I also did some other minor refatoring: * Moved the preInlineUnconditionally test in simplExprF1 to before the call to joinPointBinding_maybe, to avoid fruitless eta-expansion. * Added a boolean from_lam flag to simplNonRecE, to avoid two fruitless tests, and commented it a bit better. These refactorings seem to save 0.1% on compile-time allocation in perf/compiler; with a max saving of 1.4% in T9961 Metric Decrease: T9961 - - - - - 81eeec7f by M Farkas-Dyck at 2022-12-01T12:37:56-05:00 CI: Forbid the fully static build on Alpine to fail. To do so, we mark some tests broken in this configuration. - - - - - c5d1bf29 by Bryan Richter at 2022-12-01T12:37:56-05:00 CI: Remove ARMv7 jobs These jobs fail (and are allowed to fail) nearly every time. Soon they won't even be able to run at all, as we won't currently have runners that can run them. Fixing the latter problem is tracked in #22409. I went ahead and removed all settings and configurations. - - - - - d82992fd by Bryan Richter at 2022-12-01T12:37:56-05:00 CI: Fix CI lint Failure was introduced by conflicting changes to gen_ci.hs that did *not* trigger git conflicts. - - - - - ce126993 by Simon Peyton Jones at 2022-12-02T01:22:12-05:00 Refactor TyCon to have a top-level product This patch changes the representation of TyCon so that it has a top-level product type, with a field that gives the details (newtype, type family etc), #22458. Not much change in allocation, but execution seems to be a bit faster. Includes a change to the haddock submodule to adjust for API changes. - - - - - 74c767df by Matthew Pickering at 2022-12-02T01:22:48-05:00 ApplicativeDo: Set pattern location before running exhaustiveness checker This improves the error messages of the exhaustiveness checker when checking statements which have been moved around with ApplicativeDo. Before: Test.hs:2:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 2 | let x = () | ^^^^^^^^^^ After: Test.hs:4:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 4 | ~(Just res1) <- seq x (pure $ Nothing @()) | Fixes #22483 - - - - - 85ecc1a0 by Matthew Pickering at 2022-12-02T19:46:43-05:00 Add special case for :Main module in `GHC.IfaceToCore.mk_top_id` See Note [Root-main Id] The `:Main` special binding is actually defined in the current module (hence don't go looking for it externally) but the module name is rOOT_MAIN rather than the current module so we need this special case. There was already some similar logic in `GHC.Rename.Env` for External Core, but now the "External Core" is in interface files it needs to be moved here instead. Fixes #22405 - - - - - 108c319f by Krzysztof Gogolewski at 2022-12-02T19:47:18-05:00 Fix linearity checking in Lint Lint was not able to see that x*y <= x*y, because this inequality was decomposed to x <= x*y && y <= x*y, but there was no rule to see that x <= x*y. Fixes #22546. - - - - - bb674262 by Bryan Richter at 2022-12-03T04:38:46-05:00 Mark T16916 fragile See https://gitlab.haskell.org/ghc/ghc/-/issues/16966 - - - - - 5d267d46 by Vladislav Zavialov at 2022-12-03T04:39:22-05:00 Refactor: FreshOrReuse instead of addTyClTyVarBinds This is a refactoring that should have no effect on observable behavior. Prior to this change, GHC.HsToCore.Quote contained a few closely related functions to process type variable bindings: addSimpleTyVarBinds, addHsTyVarBinds, addQTyVarBinds, and addTyClTyVarBinds. We can classify them by their input type and name generation strategy: Fresh names only Reuse bound names +---------------------+-------------------+ [Name] | addSimpleTyVarBinds | | [LHsTyVarBndr flag GhcRn] | addHsTyVarBinds | | LHsQTyVars GhcRn | addQTyVarBinds | addTyClTyVarBinds | +---------------------+-------------------+ Note how two functions are missing. Because of this omission, there were two places where a LHsQTyVars value was constructed just to be able to pass it to addTyClTyVarBinds: 1. mk_qtvs in addHsOuterFamEqnTyVarBinds -- bad 2. mkHsQTvs in repFamilyDecl -- bad This prevented me from making other changes to LHsQTyVars, so the main goal of this refactoring is to get rid of those workarounds. The most direct solution would be to define the missing functions. But that would lead to a certain amount of code duplication. To avoid code duplication, I factored out the name generation strategy into a function parameter: data FreshOrReuse = FreshNamesOnly | ReuseBoundNames addSimpleTyVarBinds :: FreshOrReuse -> ... addHsTyVarBinds :: FreshOrReuse -> ... addQTyVarBinds :: FreshOrReuse -> ... - - - - - c189b831 by Vladislav Zavialov at 2022-12-03T04:39:22-05:00 addHsOuterFamEqnTyVarBinds: use FreshNamesOnly for explicit binders Consider this example: [d| instance forall a. C [a] where type forall b. G [a] b = Proxy b |] When we process "forall b." in the associated type instance, it is unambiguously the binding site for "b" and we want a fresh name for it. Therefore, FreshNamesOnly is more fitting than ReuseBoundNames. This should not have any observable effect but it avoids pointless lookups in the MetaEnv. - - - - - 42512264 by Ross Paterson at 2022-12-03T10:32:45+00:00 Handle type data declarations in Template Haskell quotations and splices (fixes #22500) This adds a TypeDataD constructor to the Template Haskell Dec type, and ensures that the constructors it contains go in the TyCls namespace. - - - - - 1a767fa3 by Vladislav Zavialov at 2022-12-05T05:18:50-05:00 Add BufSpan to EpaLocation (#22319, #22558) The key part of this patch is the change to mkTokenLocation: - mkTokenLocation (RealSrcSpan r _) = TokenLoc (EpaSpan r) + mkTokenLocation (RealSrcSpan r mb) = TokenLoc (EpaSpan r mb) mkTokenLocation used to discard the BufSpan, but now it is saved and can be retrieved from LHsToken or LHsUniToken. This is made possible by the following change to EpaLocation: - data EpaLocation = EpaSpan !RealSrcSpan + data EpaLocation = EpaSpan !RealSrcSpan !(Strict.Maybe BufSpan) | ... The end goal is to make use of the BufSpan in Parser/PostProcess/Haddock. - - - - - cd31acad by sheaf at 2022-12-06T15:45:58-05:00 Hadrian: fix ghcDebugAssertions off-by-one error Commit 6b2f7ffe changed the logic that decided whether to enable debug assertions. However, it had an off-by-one error, as the stage parameter to the function inconsistently referred to the stage of the compiler being used to build or the stage of the compiler we are building. This patch makes it consistent. Now the parameter always refers to the the compiler which is being built. In particular, this patch re-enables assertions in the stage 2 compiler when building with devel2 flavour, and disables assertions in the stage 2 compiler when building with validate flavour. Some extra performance tests are now run in the "validate" jobs because the stage2 compiler no longer contains assertions. ------------------------- Metric Decrease: CoOpt_Singletons MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot T11374 T12227 T12234 T13253-spj T13701 T14683 T14697 T15703 T17096 T17516 T18304 T18478 T18923 T5030 T9872b TcPlugin_RewritePerf Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T13386 T13719 T3294 T9233 T9675 parsing001 ------------------------- - - - - - 21d66db1 by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of runInstallNameTool - - - - - aaaaa79b by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of askOtool - - - - - 4e28f49e by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of runInjectRPaths - - - - - a7422580 by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of Linker.MacOS - - - - - e902d771 by Matthew Craven at 2022-12-08T08:30:23-05:00 Fix bounds-checking buglet in Data.Array.Byte ...another manifestation of #20851 which I unfortunately missed in my first pass. - - - - - 8d36c0c6 by Gergő Érdi at 2022-12-08T08:31:03-05:00 Remove copy-pasted definitions of `graphFromEdgedVertices*` - - - - - c5d8ed3a by Gergő Érdi at 2022-12-08T08:31:03-05:00 Add version of `reachableGraph` that avoids loop for cyclic inputs by building its result connected component by component Fixes #22512 - - - - - 90cd5396 by Krzysztof Gogolewski at 2022-12-08T08:31:39-05:00 Mark Type.Reflection.Unsafe as Unsafe This module can be used to construct ill-formed TypeReps, so it should be Unsafe. - - - - - 2057c77d by Ian-Woo Kim at 2022-12-08T08:32:19-05:00 Truncate eventlog event for large payload (#20221) RTS eventlog events for postCapsetVecEvent are truncated if payload is larger than EVENT_PAYLOAD_SIZE_MAX Previously, postCapsetVecEvent records eventlog event with payload of variable size larger than EVENT_PAYLOAD_SIZE_MAX (2^16) without any validation, resulting in corrupted data. For example, this happens when a Haskell binary is invoked with very long command line arguments exceeding 2^16 bytes (see #20221). Now we check the size of accumulated payload messages incrementally, and truncate the message just before the payload size exceeds EVENT_PAYLOAD_SIZE_MAX. RTS will warn the user with a message showing how many arguments are truncated. - - - - - 9ec76f61 by Cheng Shao at 2022-12-08T08:32:59-05:00 hadrian: don't add debug info to non-debug ways of rts Hadrian used to pass -g when building all ways of rts. It makes output binaries larger (especially so for wasm backend), and isn't needed by most users out there, so this patch removes that flag. In case the debug info is desired, we still pass -g3 when building the debug way, and there's also the debug_info flavour transformer which ensures -g3 is passed for all rts ways. - - - - - 7658cdd4 by Krzysztof Gogolewski at 2022-12-08T08:33:36-05:00 Restore show (typeRep @[]) == "[]" The Show instance for TypeRep [] has changed in 9.5 to output "List" because the name of the type constructor changed. This seems to be accidental and is inconsistent with TypeReps of saturated lists, which are printed as e.g. "[Int]". For now, I'm restoring the old behavior; in the future, maybe we should show TypeReps without puns (List, Tuple, Type). - - - - - 216deefd by Matthew Pickering at 2022-12-08T22:45:27-05:00 Add test for #22162 - - - - - 5d0a311f by Matthew Pickering at 2022-12-08T22:45:27-05:00 ci: Add job to test interface file determinism guarantees In this job we can run on every commit we add a test which builds the Cabal library twice and checks that the ABI hash and interface hash is stable across the two builds. * We run the test 20 times to try to weed out any race conditions due to `-j` * We run the builds in different temporary directories to try to weed out anything related to build directory affecting ABI or interface file hash. Fixes #22180 - - - - - 0a76d7d4 by Matthew Pickering at 2022-12-08T22:45:27-05:00 ci: Add job for testing interface stability across builds The idea is that both the bindists should product libraries with the same ABI and interface hash. So the job checks with ghc-pkg to make sure the computed ABI is the same. In future this job can be extended to check for the other facets of interface determinism. Fixes #22180 - - - - - 74c9bf91 by Matthew Pickering at 2022-12-08T22:45:27-05:00 backpack: Be more careful when adding together ImportAvails There was some code in the signature merging logic which added together the ImportAvails of the signature and the signature which was merged into it. This had the side-effect of making the merged signature depend on the signature (via a normal module dependency). The intention was to propagate orphan instances through the merge but this also messed up recompilation logic because we shouldn't be attempting to load B.hi when mergeing it. The fix is to just combine the part of ImportAvails that we intended to (transitive info, orphan instances and type family instances) rather than the whole thing. - - - - - d122e022 by Matthew Pickering at 2022-12-08T22:45:27-05:00 Fix mk_mod_usage_info if the interface file is not already loaded In #22217 it was observed that the order modules are compiled in affects the contents of an interface file. This was because a module dependended on another module indirectly, via a re-export but the interface file for this module was never loaded because the symbol was never used in the file. If we decide that we depend on a module then we jolly well ought to record this fact in the interface file! Otherwise it could lead to very subtle recompilation bugs if the dependency is not tracked and the module is updated. Therefore the best thing to do is just to make sure the file is loaded by calling the `loadSysInterface` function. This first checks the caches (like we did before) but then actually goes to find the interface on disk if it wasn't loaded. Fixes #22217 - - - - - ea25088d by lrzlin at 2022-12-08T22:46:06-05:00 Add initial support for LoongArch Architecture. - - - - - 9eb9d2f4 by Bodigrim at 2022-12-08T22:46:47-05:00 Update submodule mtl to 2.3.1, parsec to 3.1.15.1, haddock and Cabal to HEAD - - - - - 08d8fe2a by Bodigrim at 2022-12-08T22:46:47-05:00 Allow mtl-2.3 in hadrian - - - - - 3807a46c by Bodigrim at 2022-12-08T22:46:47-05:00 Support mtl-2.3 in check-exact - - - - - ef702a18 by Bodigrim at 2022-12-08T22:46:47-05:00 Fix tests - - - - - 3144e8ff by Sebastian Graf at 2022-12-08T22:47:22-05:00 Make (^) INLINE (#22324) So that we get to cancel away the allocation for the lazily used base. We can move `powImpl` (which *is* strict in the base) to the top-level so that we don't duplicate too much code and move the SPECIALISATION pragmas onto `powImpl`. The net effect of this change is that `(^)` plays along much better with inlining thresholds and loopification (#22227), for example in `x2n1`. Fixes #22324. - - - - - 1d3a8b8e by Matthew Pickering at 2022-12-08T22:47:59-05:00 Typeable: Fix module locations of some definitions in GHC.Types There was some confusion in Data.Typeable about which module certain wired-in things were defined in. Just because something is wired-in doesn't mean it comes from GHC.Prim, in particular things like LiftedRep and RuntimeRep are defined in GHC.Types and that's the end of the story. Things like Int#, Float# etc are defined in GHC.Prim as they have no Haskell definition site at all so we need to generate type representations for them (which live in GHC.Types). Fixes #22510 - - - - - 0f7588b5 by Sebastian Graf at 2022-12-08T22:48:34-05:00 Make `drop` and `dropWhile` fuse (#18964) I copied the fusion framework we have in place for `take`. T18964 asserts that we regress neither when fusion fires nor when it doesn't. Fixes #18964. - - - - - 26e71562 by Sebastian Graf at 2022-12-08T22:49:10-05:00 Do not strictify a DFun's parameter dictionaries (#22549) ... thus fixing #22549. The details are in the refurbished and no longer dead `Note [Do not strictify a DFun's parameter dictionaries]`. There's a regression test in T22549. - - - - - 36093407 by John Ericson at 2022-12-08T22:49:45-05:00 Delete `rts/package.conf.in` It is a relic of the Make build system. The RTS now uses a `package.conf` file generated the usual way by Cabal. - - - - - b0cc2fcf by Krzysztof Gogolewski at 2022-12-08T22:50:21-05:00 Fixes around primitive literals * The SourceText of primitive characters 'a'# did not include the #, unlike for other primitive literals 1#, 1##, 1.0#, 1.0##, "a"#. We can now remove the function pp_st_suffix, which was a hack to add the # back. * Negative primitive literals shouldn't use parentheses, as described in Note [Printing of literals in Core]. Added a testcase to T14681. - - - - - aacf616d by Bryan Richter at 2022-12-08T22:50:56-05:00 testsuite: Mark conc024 fragile on Windows - - - - - ed239a24 by Ryan Scott at 2022-12-09T09:42:16-05:00 Document TH splices' interaction with INCOHERENT instances Top-level declaration splices can having surprising interactions with `INCOHERENT` instances, as observed in #22492. This patch resolves #22492 by documenting this strange interaction in the GHC User's Guide. [ci skip] - - - - - 1023b432 by Mike Pilgrem at 2022-12-09T09:42:56-05:00 Fix #22300 Document GHC's extensions to valid whitespace - - - - - 79b0cec0 by Luite Stegeman at 2022-12-09T09:43:38-05:00 Add support for environments that don't have setImmediate - - - - - 5b007ec5 by Luite Stegeman at 2022-12-09T09:43:38-05:00 Fix bound thread status - - - - - 65335d10 by Matthew Pickering at 2022-12-09T20:15:45-05:00 Update containers submodule This contains a fix necessary for the multi-repl to work on GHC's code base where we try to load containers and template-haskell into the same session. - - - - - 4937c0bb by Matthew Pickering at 2022-12-09T20:15:45-05:00 hadrian-multi: Put interface files in separate directories Before we were putting all the interface files in the same directory which was leading to collisions if the files were called the same thing. - - - - - 8acb5b7b by Matthew Pickering at 2022-12-09T20:15:45-05:00 hadrian-toolargs: Add filepath to allowed repl targets - - - - - 5949d927 by Matthew Pickering at 2022-12-09T20:15:45-05:00 driver: Set correct UnitId when rehydrating modules We were not setting the UnitId before rehydrating modules which just led to us attempting to find things in the wrong HPT. The test for this is the hadrian-multi command (which is now added as a CI job). Fixes #22222 - - - - - ab06c0f0 by Matthew Pickering at 2022-12-09T20:15:45-05:00 ci: Add job to test hadrian-multi command I am not sure this job is good because it requires booting HEAD with HEAD, but it should be fine. - - - - - fac3e568 by Matthew Pickering at 2022-12-09T20:16:20-05:00 hadrian: Update bootstrap plans to 9.2.* series and 9.4.* series. This updates the build plans for the most recent compiler versions, as well as fixing the hadrian-bootstrap-gen script to a specific GHC version. - - - - - 195b08b4 by Matthew Pickering at 2022-12-09T20:16:20-05:00 ci: Bump boot images to use ghc-9.4.3 Also updates the bootstrap jobs to test booting 9.2 and 9.4. - - - - - c658c580 by Matthew Pickering at 2022-12-09T20:16:20-05:00 hlint: Removed redundant UnboxedSums pragmas UnboxedSums is quite confusingly implied by UnboxedTuples, alas, just the way it is. See #22485 - - - - - b3e98a92 by Oleg Grenrus at 2022-12-11T12:26:17-05:00 Add heqT, a kind-heterogeneous variant of heq CLC proposal https://github.com/haskell/core-libraries-committee/issues/99 - - - - - bfd7c1e6 by Bodigrim at 2022-12-11T12:26:55-05:00 Document that Bifunctor instances for tuples are lawful only up to laziness - - - - - 5d1a1881 by Bryan Richter at 2022-12-12T16:22:36-05:00 Mark T21336a fragile - - - - - c30accc2 by Matthew Pickering at 2022-12-12T16:23:11-05:00 Add test for #21476 This issues seems to have been fixed since the ticket was made, so let's add a test and move on. Fixes #21476 - - - - - e9d74a3e by Sebastian Graf at 2022-12-13T22:18:39-05:00 Respect -XStrict in the pattern-match checker (#21761) We were missing a call to `decideBangHood` in the pattern-match checker. There is another call in `matchWrapper.mk_eqn_info` which seems redundant but really is not; see `Note [Desugaring -XStrict matches in Pmc]`. Fixes #21761. - - - - - 884790e2 by Gergő Érdi at 2022-12-13T22:19:14-05:00 Fix loop in the interface representation of some `Unfolding` fields As discovered in #22272, dehydration of the unfolding info of a recursive definition used to involve a traversal of the definition itself, which in turn involves traversing the unfolding info. Hence, a loop. Instead, we now store enough data in the interface that we can produce the unfolding info without this traversal. See Note [Tying the 'CoreUnfolding' knot] for details. Fixes #22272 Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 9f301189 by Alan Zimmerman at 2022-12-13T22:19:50-05:00 EPA: When splitting out header comments, keep ones for first decl Any comments immediately preceding the first declaration are no longer kept as header comments, but attach to the first declaration instead. - - - - - 8b1f1b45 by Sylvain Henry at 2022-12-13T22:20:28-05:00 JS: fix object file name comparison (#22578) - - - - - e9e161bb by Bryan Richter at 2022-12-13T22:21:03-05:00 configure: Bump min bootstrap GHC version to 9.2 - - - - - 75855643 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Don't enable TSAN in stage0 build - - - - - da7b51d8 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce blockConcat - - - - - 34f6b09c by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce MemoryOrderings - - - - - 43beaa7b by Ben Gamari at 2022-12-15T03:54:02-05:00 llvm: Respect memory specified orderings - - - - - 8faf74fc by Ben Gamari at 2022-12-15T03:54:02-05:00 Codegen/x86: Eliminate barrier for relaxed accesses - - - - - 6cc3944a by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Reduce some repetition - - - - - 6c9862c4 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Add syntax for ordered loads and stores - - - - - 748490d2 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Atomic load syntax Originally I had thought I would just use the `prim` call syntax instead of introducing new syntax for atomic loads. However, it turns out that `prim` call syntax tends to make things quite unreadable. This new syntax seems quite natural. - - - - - 28c6781a by Ben Gamari at 2022-12-15T03:54:02-05:00 codeGen: Introduce ThreadSanitizer instrumentation This introduces a new Cmm pass which instruments the program with ThreadSanitizer annotations, allowing full tracking of mutator memory accesses via TSAN. - - - - - d97aa311 by Ben Gamari at 2022-12-15T03:54:02-05:00 Hadrian: Drop TSAN_ENABLED define from flavour This is redundant since the TSANUtils.h already defines it. - - - - - 86974ef1 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Enable Cmm instrumentation in TSAN flavour - - - - - 93723290 by Ben Gamari at 2022-12-15T03:54:02-05:00 rts: Ensure that global regs are never passed as fun call args This is in general unsafe as they may be clobbered if they are mapped to caller-saved machine registers. See Note [Register parameter passing]. - - - - - 2eb0fb87 by Matthew Pickering at 2022-12-15T03:54:39-05:00 Package Imports: Get candidate packages also from re-exported modules Previously we were just looking at the direct imports to try and work out what a package qualifier could apply to but #22333 pointed out we also needed to look for reexported modules. Fixes #22333 - - - - - 552b7908 by Ben Gamari at 2022-12-15T03:55:15-05:00 compiler: Ensure that MutVar operations have necessary barriers Here we add acquire and release barriers in readMutVar# and writeMutVar#, which are necessary for soundness. Fixes #22468. - - - - - 933d61a4 by Simon Peyton Jones at 2022-12-15T03:55:51-05:00 Fix bogus test in Lint The Lint check for branch compatiblity within an axiom, in GHC.Core.Lint.compatible_branches was subtly different to the check made when contructing an axiom, in GHC.Core.FamInstEnv.compatibleBranches. The latter is correct, so I killed the former and am now using the latter. On the way I did some improvements to pretty-printing and documentation. - - - - - 03ed0b95 by Ryan Scott at 2022-12-15T03:56:26-05:00 checkValidInst: Don't expand synonyms when splitting sigma types Previously, the `checkValidInst` function (used when checking that an instance declaration is headed by an actual type class, not a type synonym) was using `tcSplitSigmaTy` to split apart the `forall`s and instance context. This is incorrect, however, as `tcSplitSigmaTy` expands type synonyms, which can cause instances headed by quantified constraint type synonyms to be accepted erroneously. This patch introduces `splitInstTyForValidity`, a variant of `tcSplitSigmaTy` specialized for validity checking that does _not_ expand type synonyms, and uses it in `checkValidInst`. Fixes #22570. - - - - - ed056bc3 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/Messages: Refactor This doesn't change behavior but makes the code a bit easier to follow. - - - - - 7356f8e0 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/ThreadPaused: Ordering fixes - - - - - 914f0025 by Ben Gamari at 2022-12-16T16:12:44-05:00 eventlog: Silence spurious data race - - - - - fbc84244 by Ben Gamari at 2022-12-16T16:12:44-05:00 Introduce SET_INFO_RELEASE for Cmm - - - - - 821b5472 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Use fences instead of explicit barriers - - - - - 2228c999 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/stm: Fix memory ordering in readTVarIO# See #22421. - - - - - 99269b9f by Ben Gamari at 2022-12-16T16:12:44-05:00 Improve heap memory barrier Note Also introduce MUT_FIELD marker in Closures.h to document mutable fields. - - - - - 70999283 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Introduce getNumCapabilities And ensure accesses to n_capabilities are atomic (although with relaxed ordering). This is necessary as RTS API callers may concurrently call into the RTS without holding a capability. - - - - - 98689f77 by Ben Gamari at 2022-12-16T16:12:44-05:00 ghc: Fix data race in dump file handling Previously the dump filename cache would use a non-atomic update which could potentially result in lost dump contents. Note that this is still a bit racy since the first writer may lag behind a later appending writer. - - - - - 605d9547 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Always use atomics for context_switch and interrupt Since these are modified by the timer handler. - - - - - 86f20258 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts/Timer: Always use atomic operations As noted in #22447, the existence of the pthread-based ITimer implementation means that we cannot assume that the program is single-threaded. - - - - - f8e901dc by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate recent_activity access This makes it easier to ensure that it is accessed using the necessary atomic operations. - - - - - e0affaa9 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate access to capabilities array - - - - - 7ca683e4 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate sched_state - - - - - 1cf13bd0 by Ben Gamari at 2022-12-16T16:12:45-05:00 PrimOps: Fix benign MutVar race Relaxed ordering is fine here since the later CAS implies a release. - - - - - 3d2a7e08 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Style fix - - - - - 82c62074 by Ben Gamari at 2022-12-16T16:12:45-05:00 compiler: Use release store in eager blackholing - - - - - eb1a0136 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Fix ordering of makeStableName - - - - - ad0e260a by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Use ordered accesses instead of explicit barriers - - - - - a3eccf06 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Statically allocate capabilities This is a rather simplistic way of solving #17289. - - - - - 287fa3fb by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Ensure that all accesses to pending_sync are atomic - - - - - 351eae58 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Note race with wakeBlockingQueue - - - - - 5acf33dd by Bodigrim at 2022-12-16T16:13:22-05:00 Bump submodule directory to 1.3.8.0 and hpc to HEAD - - - - - 0dd95421 by Bodigrim at 2022-12-16T16:13:22-05:00 Accept allocations increase on Windows This is because of `filepath-1.4.100.0` and AFPP, causing increasing round-trips between lists and ByteArray. See #22625 for discussion. Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T10547 T12150 T12227 T12234 T12425 T13035 T13253 T13253-spj T13701 T13719 T15703 T16875 T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T21839r T5837 T6048 T9198 T9961 TcPlugin_RewritePerf hard_hole_fits - - - - - ef9ac9d2 by Cheng Shao at 2022-12-16T16:13:59-05:00 testsuite: Mark T9405 as fragile instead of broken on Windows It's starting to pass again, and the unexpected pass blocks CI. - - - - - 1f3abd85 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: remove obsolete commented code in wasm NCG It was just a temporary hack to workaround a bug in the relooper, that bug has been fixed long before the wasm backend is merged. - - - - - e3104eab by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add missing export list of GHC.CmmToAsm.Wasm.FromCmm Also removes some unreachable code here. - - - - - 1c6930bf by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: change fallback function signature to Cmm function signature in wasm NCG In the wasm NCG, when handling a `CLabel` of undefined function without knowing its function signature, we used to fallback to `() -> ()` which is accepted by `wasm-ld`. This patch changes it to the signature of Cmm functions, which equally works, but would be required when we emit tail call instructions. - - - - - 8a81d9d9 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add optional tail-call support in wasm NCG When the `-mtail-call` clang flag is passed at configure time, wasm tail-call extension is enabled, and the wasm NCG will emit `return_call`/`return_call_indirect` instructions to take advantage of it and avoid the `StgRun` trampoline overhead. Closes #22461. - - - - - d1431cc0 by Cheng Shao at 2022-12-17T08:07:15-05:00 base: add missing autoconf checks for waitpid/umask These are not present in wasi-libc. Required for fixing #22589 - - - - - da3f1e91 by Cheng Shao at 2022-12-17T08:07:51-05:00 compiler: make .wasm the default executable extension on wasm32 Following convention as in other wasm toolchains. Fixes #22594. - - - - - ad21f4ef by Cheng Shao at 2022-12-17T08:07:51-05:00 ci: support hello.wasm in ci.sh cross testing logic - - - - - 6fe2d778 by amesgen at 2022-12-18T19:33:49-05:00 Correct `exitWith` Haddocks The `IOError`-specific `catch` in the Prelude is long gone. - - - - - b3eacd64 by Ben Gamari at 2022-12-18T19:34:24-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 761c1f49 by Ben Gamari at 2022-12-18T19:35:00-05:00 rts/libdw: Silence uninitialized usage warnings As noted in #22538, previously some GCC versions warned that various locals in Libdw.c may be used uninitialized. Although this wasn't strictly true (since they were initialized in an inline assembler block) we fix this by providing explicit empty initializers. Fixes #22538 - - - - - 5e047eff by Matthew Pickering at 2022-12-20T15:12:04+00:00 testsuite: Mark T16392 as fragile on windows See #22649 - - - - - 703a4665 by M Farkas-Dyck at 2022-12-20T21:14:46-05:00 Scrub some partiality in `GHC.Cmm.Info.Build`: `doSRTs` takes a `[(CAFSet, CmmDecl)]` but truly wants a `[(CAFSet, CmmStatics)]`. - - - - - 9736ab74 by Matthew Pickering at 2022-12-20T21:15:22-05:00 packaging: Fix upload_ghc_libs.py script This change reflects the changes where .cabal files are now generated by hadrian rather than ./configure. Fixes #22518 - - - - - 7c6de18d by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Drop uses of AC_PROG_CC_C99 As noted in #22566, this macro is deprecated as of autoconf-2.70 `AC_PROG_CC` now sets `ac_cv_prog_cc_c99` itself. Closes #22566. - - - - - 36c5d98e by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Use AS_HELP_STRING instead of AC_HELP_STRING The latter has been deprecated. See #22566. - - - - - befe6ff8 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: fix various usages of head and tail - - - - - 666d0ba7 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: avoid head and tail in parseCallEscape and around - - - - - 5d96fd50 by Bodigrim at 2022-12-20T21:16:37-05:00 Make GHC.Driver.Main.hscTcRnLookupRdrName to return NonEmpty - - - - - 3ce2ab94 by Bodigrim at 2022-12-21T06:17:56-05:00 Allow transformers-0.6 in ghc, ghci, ghc-bin and hadrian - - - - - 954de93a by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule haskeline to HEAD (to allow transformers-0.6) - - - - - cefbeec3 by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule transformers to 0.6.0.4 - - - - - b4730b62 by Bodigrim at 2022-12-21T06:17:56-05:00 Fix tests T13253 imports MonadTrans, which acquired a quantified constraint in transformers-0.6, thus increase in allocations Metric Increase: T13253 - - - - - 0be75261 by Simon Peyton Jones at 2022-12-21T06:18:32-05:00 Abstract over the right free vars Fix #22459, in two ways: (1) Make the Specialiser not create a bogus specialisation if it is presented by strangely polymorphic dictionary. See Note [Weird special case in SpecDict] in GHC.Core.Opt.Specialise (2) Be more careful in abstractFloats See Note [Which type variables to abstract over] in GHC.Core.Opt.Simplify.Utils. So (2) stops creating the excessively polymorphic dictionary in abstractFloats, while (1) stops crashing if some other pass should nevertheless create a weirdly polymorphic dictionary. - - - - - df7bc6b3 by Ying-Ruei Liang (TheKK) at 2022-12-21T14:31:54-05:00 rts: explicitly store return value of ccall checkClosure to prevent type error (#22617) - - - - - e193e537 by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. - - - - - 3d55d8ab by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 - - - - - ceb2e9b9 by Ben Gamari at 2022-12-21T15:26:08-05:00 configure: Bump version to 9.6 - - - - - fb4d36c4 by Ben Gamari at 2022-12-21T15:27:49-05:00 base: Bump version to 4.18 Requires various submodule bumps. - - - - - 93ee7e90 by Ben Gamari at 2022-12-21T15:27:49-05:00 ghc-boot: Fix bootstrapping - - - - - fc3a2232 by Ben Gamari at 2022-12-22T13:45:06-05:00 Bump GHC version to 9.7 - - - - - 914f7fe3 by Andreas Klebinger at 2022-12-22T23:36:10-05:00 Don't consider large byte arrays/compact regions pinned. Workaround for #22255 which showed how treating large/compact regions as pinned could cause segfaults. - - - - - 32b32d7f by Matthew Pickering at 2022-12-22T23:36:46-05:00 hadrian bindist: Install manpages to share/man/man1/ghc.1 When the installation makefile was copied over the manpages were no longer installed in the correct place. Now we install it into share/man/man1/ghc.1 as the make build system did. Fixes #22371 - - - - - b3ddf803 by Ben Gamari at 2022-12-22T23:37:23-05:00 rts: Drop paths from configure from cabal file A long time ago we would rely on substitutions from the configure script to inject paths of the include and library directories of libffi and libdw. However, now these are instead handled inside Hadrian when calling Cabal's `configure` (see the uses of `cabalExtraDirs` in Hadrian's `Settings.Packages.packageArgs`). While the occurrences in the cabal file were redundant, they did no harm. However, since b5c714545abc5f75a1ffdcc39b4bfdc7cd5e64b4 they have no longer been interpolated. @mpickering noticed the suspicious uninterpolated occurrence of `@FFIIncludeDir@` in #22595, prompting this commit to finally remove them. - - - - - b2c7523d by Ben Gamari at 2022-12-22T23:37:59-05:00 Bump libffi-tarballs submodule We will now use libffi-3.4.4. - - - - - 3699a554 by Alan Zimmerman at 2022-12-22T23:38:35-05:00 EPA: Make EOF position part of AnnsModule Closes #20951 Closes #19697 - - - - - 99757ce8 by Sylvain Henry at 2022-12-22T23:39:13-05:00 JS: fix support for -outputdir (#22641) The `-outputdir` option wasn't correctly handled with the JS backend because the same code path was used to handle both objects produced by the JS backend and foreign .js files. Now we clearly distinguish the two in the pipeline, fixing the bug. - - - - - 02ed7d78 by Simon Peyton Jones at 2022-12-22T23:39:49-05:00 Refactor mkRuntimeError This patch fixes #22634. Because we don't have TYPE/CONSTRAINT polymorphism, we need two error functions rather than one. I took the opportunity to rname runtimeError to impossibleError, to line up with mkImpossibleExpr, and avoid confusion with the genuine runtime-error-constructing functions. - - - - - 35267f07 by Ben Gamari at 2022-12-22T23:40:32-05:00 base: Fix event manager shutdown race on non-Linux platforms During shutdown it's possible that we will attempt to use a closed fd to wakeup another capability's event manager. On the Linux eventfd path we were careful to handle this. However on the non-Linux path we failed to do so. Fix this. - - - - - 317f45c1 by Simon Peyton Jones at 2022-12-22T23:41:07-05:00 Fix unifier bug: failing to decompose over-saturated type family This simple patch fixes #22647 - - - - - 14b2e3d3 by Ben Gamari at 2022-12-22T23:41:42-05:00 rts/m32: Fix sanity checking Previously we would attempt to clear pages which were marked as read-only. Fix this. - - - - - 16a1bcd1 by Matthew Pickering at 2022-12-23T09:15:24+00:00 ci: Move wasm pipelines into nightly rather than master See #22664 for the changes which need to be made to bring one of these back to the validate pipeline. - - - - - 18d2acd2 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in marking of blackholes We must use an acquire-fence when marking to ensure that the indirectee is visible. - - - - - 11241efa by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix segment list races - - - - - 602455c9 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Use atomic when looking at bd->gen Since it may have been mutated by a moving GC. - - - - - 9d63b160 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Eliminate race in bump_static_flag To ensure that we don't race with a mutator entering a new CAF we take the SM mutex before touching static_flag. The other option here would be to instead modify newCAF to use a CAS but the present approach is a bit safer. - - - - - 26837523 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that mutable fields have acquire barrier - - - - - 8093264a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix races in collector status tracking Mark a number of accesses to do with tracking of the status of the concurrent collection thread as atomic. No interesting races here, merely necessary to satisfy TSAN. - - - - - 387d4fcc by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make segment state updates atomic - - - - - 543cae00 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Refactor update remembered set initialization This avoids a lock inversion between the storage manager mutex and the stable pointer table mutex by not dropping the SM_MUTEX in nonmovingCollect. This requires quite a bit of rejiggering but it does seem like a better strategy. - - - - - c9936718 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that we aren't holding locks when closing them TSAN complains about this sort of thing. - - - - - 0cd31f7d by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make bitmap accesses atomic This is a benign race on any sensible hard since these are byte accesses. Nevertheless, atomic accesses are necessary to satisfy TSAN. - - - - - d3fe110a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix benign race in update remembered set check Relaxed load is fine here since we will take the lock before looking at the list. - - - - - ab6cf893 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in shortcutting We must use an acquire load to read the info table pointer since if we find an indirection we must be certain that we see the indirectee. - - - - - 36c9f23c by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make free list counter accesses atomic Since these may race with the allocator(s). - - - - - aebef31c by doyougnu at 2022-12-23T19:10:09-05:00 add GHC.Utils.Binary.foldGet' and use for Iface A minor optimization to remove lazy IO and a lazy accumulator strictify foldGet' IFace.Binary: use strict foldGet' remove superfluous bang - - - - - 5eb357d9 by Ben Gamari at 2022-12-24T00:41:05-05:00 compiler: Ensure that GHC toolchain is first in search path As noted in #22561, it is important that GHC's toolchain look first for its own headers and libraries to ensure that the system's are not found instead. If this happens things can break in surprising ways (e.g. see #22561). - - - - - cbaebfb9 by Matthew Pickering at 2022-12-24T00:41:40-05:00 head.hackage: Use slow-validate bindist for linting jobs This enables the SLOW_VALIDATE env var for the linting head.hackage jobs, namely the jobs enabled manually, by the label or on the nightly build now use the deb10-numa-slow-validate bindist which has assertions enabled. See #22623 for a ticket which was found by using this configuration already! The head.hackage jobs triggered by upstream CI are now thusly: hackage-lint: Can be triggered on any MR, normal validate pipeline or nightly build. Runs head.hackage with -dlint and a slow-validate bindist hackage-label-lint: Trigged on MRs with "user-facing" label, runs the slow-validate head.hackage build with -dlint. nightly-hackage-lint: Runs automatically on nightly pipelines with slow-validate + dlint config. nightly-hackage-perf: Runs automaticaly on nightly pipelines with release build and eventlogging enabled. release-hackage-lint: Runs automatically on release pipelines with -dlint on a release bindist. - - - - - f4850f36 by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Don't run abi-test-nightly on release jobs The test is not configured to get the correct dependencies for the release pipelines (and indeed stops the release pipeline being run at all) - - - - - c264b06b by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Run head.hackage jobs on upstream-testing branch rather than master This change allows less priviledged users to trigger head.hackage jobs because less permissions are needed to trigger jobs on the upstream-testing branch, which is not protected. There is a CI job which updates upstream-testing each hour to the state of the master branch so it should always be relatively up-to-date. - - - - - 63b97430 by Ben Gamari at 2022-12-24T00:42:16-05:00 llvmGen: Fix relaxed ordering Previously I used LLVM's `unordered` ordering for the C11 `relaxed` ordering. However, this is wrong and should rather use the LLVM `monotonic` ordering. Fixes #22640 - - - - - f42ba88f by Ben Gamari at 2022-12-24T00:42:16-05:00 gitlab-ci: Introduce aarch64-linux-llvm job This nightly job will ensure that we don't break the LLVM backend on AArch64/Linux by bootstrapping GHC. This would have caught #22640. - - - - - 6d62f6bf by Matthew Pickering at 2022-12-24T00:42:51-05:00 Store RdrName rather than OccName in Holes In #20472 it was pointed out that you couldn't defer out of scope but the implementation collapsed a RdrName into an OccName to stuff it into a Hole. This leads to the error message for a deferred qualified name dropping the qualification which affects the quality of the error message. This commit adds a bit more structure to a hole, so a hole can replace a RdrName without losing information about what that RdrName was. This is important when printing error messages. I also added a test which checks the Template Haskell deferral of out of scope qualified names works properly. Fixes #22130 - - - - - 3c3060e4 by Richard Eisenberg at 2022-12-24T17:34:19+00:00 Drop support for kind constraints. This implements proposal 547 and closes ticket #22298. See the proposal and ticket for motivation. Compiler perf improves a bit Metrics: compile_time/bytes allocated ------------------------------------- CoOpt_Singletons(normal) -2.4% GOOD T12545(normal) +1.0% T13035(normal) -13.5% GOOD T18478(normal) +0.9% T9872d(normal) -2.2% GOOD geo. mean -0.2% minimum -13.5% maximum +1.0% Metric Decrease: CoOpt_Singletons T13035 T9872d - - - - - 6d7d4393 by Ben Gamari at 2022-12-24T21:09:56-05:00 hadrian: Ensure that linker scripts are used when merging objects In #22527 @rui314 inadvertantly pointed out a glaring bug in Hadrian's implementation of the object merging rules: unlike the old `make` build system we utterly failed to pass the needed linker scripts. Fix this. - - - - - a5bd0eb8 by Bodigrim at 2022-12-24T21:10:34-05:00 Document infelicities of instance Ord Double and workarounds - - - - - 62b9a7b2 by Zubin Duggal at 2023-01-03T12:22:11+00:00 Force the Docs structure to prevent leaks in GHCi with -haddock without -fwrite-interface Involves adding many new NFData instances. Without forcing Docs, references to the TcGblEnv for each module are retained by the Docs structure. Usually these are forced when the ModIface is serialised but not when we aren't writing the interface. - - - - - 21bedd84 by Facundo Domínguez at 2023-01-03T23:27:30-05:00 Explain the auxiliary functions of permutations - - - - - 32255d05 by Matthew Pickering at 2023-01-04T11:58:42+00:00 compiler: Add -f[no-]split-sections flags Here we add a `-fsplit-sections` flag which may some day replace `-split-sections`. This has the advantage of automatically providing a `-fno-split-sections` flag, which is useful for our packaging because we enable `-split-sections` by default but want to disable it in certain configurations. - - - - - e640940c by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Fix computation of tables_next_to_code for outOfTreeCompiler This copy-pasto was introduced in de5fb3489f2a9bd6dc75d0cb8925a27fe9b9084b - - - - - 15bee123 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add test:all_deps to build just testsuite dependencies Fixes #22534 - - - - - fec6638e by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add no_split_sections tranformer This transformer reverts the effect of `split_sections`, which we intend to use for platforms which don't support split sections. In order to achieve this we have to modify the implemntation of the split_sections transformer to store whether we are enabling split_sections directly in the `Flavour` definition. This is because otherwise there's no convenient way to turn off split_sections due to having to pass additional linker scripts when merging objects. - - - - - 3dc05726 by Matthew Pickering at 2023-01-04T11:58:42+00:00 check-exact: Fix build with -Werror - - - - - 53a6ae7a by Matthew Pickering at 2023-01-04T11:58:42+00:00 ci: Build all test dependencies with in-tree compiler This means that these executables will honour flavour transformers such as "werror". Fixes #22555 - - - - - 32e264c1 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Document using GHC environment variable to select boot compiler Fixes #22340 - - - - - be9dd9b0 by Matthew Pickering at 2023-01-04T11:58:42+00:00 packaging: Build perf builds with -split-sections In 8f71d958 the make build system was made to use split-sections on linux systems but it appears this logic never made it to hadrian. There is the split_sections flavour transformer but this doesn't appear to be used for perf builds on linux. This is disbled on deb9 and windows due to #21670 Closes #21135 - - - - - 00dc5106 by Matthew Pickering at 2023-01-04T14:32:45-05:00 sphinx: Use modern syntax for extlinks This fixes the following build error: ``` Command line: /opt/homebrew/opt/sphinx-doc/bin/sphinx-build -b man -d /private/tmp/extra-dir-55768274273/.doctrees-man -n -w /private/tmp/extra-dir-55768274273/.log docs/users_guide /private/tmp/extra-dir-55768274273 ===> Command failed with error code: 2 Exception occurred: File "/opt/homebrew/Cellar/sphinx-doc/6.0.0/libexec/lib/python3.11/site-packages/sphinx/ext/extlinks.py", line 101, in role title = caption % part ~~~~~~~~^~~~~~ TypeError: not all arguments converted during string formatting ``` I tested on Sphinx-5.1.1 and Sphinx-6.0.0 Thanks for sterni for providing instructions about how to test using sphinx-6.0.0. Fixes #22690 - - - - - 541aedcd by Krzysztof Gogolewski at 2023-01-05T10:48:34-05:00 Misc cleanup - Remove unused uniques and hs-boot declarations - Fix types of seq and unsafeCoerce# - Remove FastString/String roundtrip in JS - Use TTG to enforce totality - Remove enumeration in Heap/Inspect; the 'otherwise' clause serves the primitive types well. - - - - - 22bb8998 by Alan Zimmerman at 2023-01-05T10:49:09-05:00 EPA: Do not collect comments from end of file In Parser.y semis1 production triggers for the virtual semi at the end of the file. This is detected by it being zero length. In this case, do not extend the span being used to gather comments, so any final comments are allocated at the module level instead. - - - - - 9e077999 by Vladislav Zavialov at 2023-01-05T23:01:55-05:00 HsToken in TypeArg (#19623) Updates the haddock submodule. - - - - - b2a2db04 by Matthew Pickering at 2023-01-05T23:02:30-05:00 Revert "configure: Drop uses of AC_PROG_CC_C99" This reverts commit 7c6de18dd3151ead954c210336728e8686c91de6. Centos7 using a very old version of the toolchain (autotools-2.69) where the behaviour of these macros has not yet changed. I am reverting this without haste as it is blocking the 9.6 branch. Fixes #22704 - - - - - 28f8c0eb by Luite Stegeman at 2023-01-06T18:16:24+09:00 Add support for sized literals in the bytecode interpreter. The bytecode interpreter only has branching instructions for word-sized values. These are used for pattern matching. Branching instructions for other types (e.g. Int16# or Word8#) weren't needed, since unoptimized Core or STG never requires branching on types like this. It's now possible for optimized STG to reach the bytecode generator (e.g. fat interface files or certain compiler flag combinations), which requires dealing with various sized literals in branches. This patch improves support for generating bytecode from optimized STG by adding the following new bytecode instructions: TESTLT_I64 TESTEQ_I64 TESTLT_I32 TESTEQ_I32 TESTLT_I16 TESTEQ_I16 TESTLT_I8 TESTEQ_I8 TESTLT_W64 TESTEQ_W64 TESTLT_W32 TESTEQ_W32 TESTLT_W16 TESTEQ_W16 TESTLT_W8 TESTEQ_W8 Fixes #21945 - - - - - ac39e8e9 by Matthew Pickering at 2023-01-06T13:47:00-05:00 Only store Name in FunRhs rather than Id with knot-tied fields All the issues here have been caused by #18758. The goal of the ticket is to be able to talk about things like `LTyClDecl GhcTc`. In the case of HsMatchContext, the correct "context" is whatever we want, and in fact storing just a `Name` is sufficient and correct context, even if the rest of the AST is storing typechecker Ids. So this reverts (#20415, !5579) which intended to get closed to #18758 but didn't really and introduced a few subtle bugs. Printing of an error message in #22695 would just hang, because we would attempt to print the `Id` in debug mode to assertain whether it was empty or not. Printing the Name is fine for the error message. Another consequence is that when `-dppr-debug` was enabled the compiler would hang because the debug printing of the Id would try and print fields which were not populated yet. This also led to 32070e6c2e1b4b7c32530a9566fe14543791f9a6 having to add a workaround for the `checkArgs` function which was probably a very similar bug to #22695. Fixes #22695 - - - - - c306d939 by Matthew Pickering at 2023-01-06T22:08:53-05:00 ci: Upgrade darwin, windows and freebsd CI to use GHC-9.4.3 Fixes #22599 - - - - - 0db496ff by Matthew Pickering at 2023-01-06T22:08:53-05:00 darwin ci: Explicitly pass desired build triple to configure On the zw3rk machines for some reason the build machine was inferred to be arm64. Setting the build triple appropiately resolve this confusion and we produce x86 binaries. - - - - - 2459c358 by Ben Gamari at 2023-01-06T22:09:29-05:00 rts: MUT_VAR is not a StgMutArrPtrs There was previously a comment claiming that the MUT_VAR closure type had the layout of StgMutArrPtrs. - - - - - 6206cb92 by Simon Peyton Jones at 2023-01-07T12:14:40-05:00 Make FloatIn robust to shadowing This MR fixes #22622. See the new Note [Shadowing and name capture] I did a bit of refactoring in sepBindsByDropPoint too. The bug doesn't manifest in HEAD, but it did show up in 9.4, so we should backport this patch to 9.4 - - - - - a960ca81 by Matthew Pickering at 2023-01-07T12:15:15-05:00 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s - - - - - 73484710 by Matthew Pickering at 2023-01-07T12:15:15-05:00 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. - - - - - 8c0ea25f by Matthew Pickering at 2023-01-07T12:15:15-05:00 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes - - - - - 365b3045 by Matthew Pickering at 2023-01-09T02:36:20-05:00 Disable split sections on aarch64-deb10 build See #22722 Failure on this job: https://gitlab.haskell.org/ghc/ghc/-/jobs/1287852 ``` Unexpected failures: /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T10828.run T10828 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T13123.run T13123 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T20590.run T20590 [exit code non-0] (ext-interp) Appending 232 stats to file: /builds/ghc/ghc/performance-metrics.tsv ``` ``` Compile failed (exit code 1) errors were: data family D_0 a_1 :: * -> * data instance D_0 GHC.Types.Int GHC.Types.Bool :: * where DInt_2 :: D_0 GHC.Types.Int GHC.Types.Bool data E_3 where MkE_4 :: a_5 -> E_3 data Foo_6 a_7 b_8 where MkFoo_9, MkFoo'_10 :: a_11 -> Foo_6 a_11 b_12 newtype Bar_13 :: * -> GHC.Types.Bool -> * where MkBar_14 :: a_15 -> Bar_13 a_15 b_16 data T10828.T (a_0 :: *) where T10828.MkT :: forall (a_1 :: *) . a_1 -> a_1 -> T10828.T a_1 T10828.MkC :: forall (a_2 :: *) (b_3 :: *) . (GHC.Types.~) a_2 GHC.Types.Int => {T10828.foo :: a_2, T10828.bar :: b_3} -> T10828.T GHC.Types.Int T10828.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: (do TyConI dec <- runQ $ reify (mkName "T") runIO $ putStrLn (pprint dec) >> hFlush stdout d <- runQ $ [d| data T' a :: Type where MkT' :: a -> a -> T' a MkC' :: forall a b. (a ~ Int) => {foo :: a, bar :: b} -> T' Int |] runIO $ putStrLn (pprint d) >> hFlush stdout ....) *** unexpected failure for T10828(ext-interp) =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] Compile failed (exit code 1) errors were: T13123.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data GADT where MkGADT :: forall k proxy (a :: k). proxy a -> GADT |]) *** unexpected failure for T13123(ext-interp) =====> 7100 of 9215 [0, 2, 0] =====> 7100 of 9215 [0, 2, 0] =====> 7200 of 9215 [0, 2, 0] Compile failed (exit code 1) errors were: T20590.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data T where MkT :: forall a. a -> T |]) *** unexpected failure for T20590(ext-interp) ``` Looks fairly worrying to me. - - - - - 965a2735 by Alan Zimmerman at 2023-01-09T02:36:20-05:00 EPA: exact print HsDocTy To match ghc-exactprint https://github.com/alanz/ghc-exactprint/pull/121 - - - - - 5d65773e by John Ericson at 2023-01-09T20:39:27-05:00 Remove RTS hack for configuring See the brand new Note [Undefined symbols in the RTS] for additional details. - - - - - e3fff751 by Sebastian Graf at 2023-01-09T20:40:02-05:00 Handle shadowing in DmdAnal (#22718) Previously, when we had a shadowing situation like ```hs f x = ... -- demand signature <1L><1L> main = ... \f -> f 1 ... ``` we'd happily use the shadowed demand signature at the call site inside the lambda. Of course, that's wrong and solution is simply to remove the demand signature from the `AnalEnv` when we enter the lambda. This patch does so for all binding constructs Core. In #22718 the issue was caused by LetUp not shadowing away the existing demand signature for the let binder in the let body. The resulting absent error is fickle to reproduce; hence no reproduction test case. #17478 would help. Fixes #22718. It appears that TcPlugin_Rewrite regresses by ~40% on Darwin. It is likely that DmdAnal was exploiting ill-scoped analysis results. Metric increase ['bytes allocated'] (test_env=x86_64-darwin-validate): TcPlugin_Rewrite - - - - - d53f6f4d by Oleg Grenrus at 2023-01-09T21:11:02-05:00 Add safe list indexing operator: !? With Joachim's amendments. Implements https://github.com/haskell/core-libraries-committee/issues/110 - - - - - cfaf1ad7 by Nicolas Trangez at 2023-01-09T21:11:03-05:00 rts, tests: limit thread name length to 15 bytes On Linux, `pthread_setname_np` (or rather, the kernel) only allows for thread names up to 16 bytes, including the terminating null byte. This commit adds a note pointing this out in `createOSThread`, and fixes up two instances where a thread name of more than 15 characters long was used (in the RTS, and in a test-case). Fixes: #22366 Fixes: https://gitlab.haskell.org/ghc/ghc/-/issues/22366 See: https://gitlab.haskell.org/ghc/ghc/-/issues/22366#note_460796 - - - - - 64286132 by Matthew Pickering at 2023-01-09T21:11:03-05:00 Store bootstrap_llvm_target and use it to set LlvmTarget in bindists This mirrors some existing logic for the bootstrap_target which influences how TargetPlatform is set. As described on #21970 not storing this led to `LlvmTarget` being set incorrectly and hence the wrong `--target` flag being passed to the C compiler. Towards #21970 - - - - - 4724e8d1 by Matthew Pickering at 2023-01-09T21:11:04-05:00 Check for FP_LD_NO_FIXUP_CHAINS in installation configure script Otherwise, when installing from a bindist the C flag isn't passed to the C compiler. This completes the fix for #22429 - - - - - 2e926b88 by Georgi Lyubenov at 2023-01-09T21:11:07-05:00 Fix outdated link to Happy section on sequences - - - - - 146a1458 by Matthew Pickering at 2023-01-09T21:11:07-05:00 Revert "NCG(x86): Compile add+shift as lea if possible." This reverts commit 20457d775885d6c3df020d204da9a7acfb3c2e5a. See #22666 and #21777 - - - - - 6e6adbe3 by Jade Lovelace at 2023-01-11T00:55:30-05:00 Fix tcPluginRewrite example - - - - - faa57138 by Jade Lovelace at 2023-01-11T00:55:31-05:00 fix missing haddock pipe - - - - - 0470ea7c by Florian Weimer at 2023-01-11T00:56:10-05:00 m4/fp_leading_underscore.m4: Avoid implicit exit function declaration And switch to a new-style function definition. Fixes build issues with compilers that do not accept implicit function declarations. - - - - - b2857df4 by HaskellMouse at 2023-01-11T00:56:52-05:00 Added a new warning about compatibility with RequiredTypeArguments This commit introduces a new warning that indicates code incompatible with future extension: RequiredTypeArguments. Enabling this extension may break some code and the warning will help to make it compatible in advance. - - - - - 5f17e21a by Ben Gamari at 2023-01-11T00:57:27-05:00 testsuite: Drop testheapalloced.c As noted in #22414, this file (which appears to be a benchmark for characterising the one-step allocator's MBlock cache) is currently unreferenced. Remove it. Closes #22414. - - - - - bc125775 by Vladislav Zavialov at 2023-01-11T00:58:03-05:00 Introduce the TypeAbstractions language flag GHC Proposals #448 "Modern scoped type variables" and #425 "Invisible binders in type declarations" introduce a new language extension flag: TypeAbstractions. Part of the functionality guarded by this flag has already been implemented, namely type abstractions in constructor patterns, but it was guarded by a combination of TypeApplications and ScopedTypeVariables instead of a dedicated language extension flag. This patch does the following: * introduces a new language extension flag TypeAbstractions * requires TypeAbstractions for @a-syntax in constructor patterns instead of TypeApplications and ScopedTypeVariables * creates a User's Guide page for TypeAbstractions and moves the "Type Applications in Patterns" section there To avoid a breaking change, the new flag is implied by ScopedTypeVariables and is retroactively added to GHC2021. Metric Decrease: MultiLayerModulesTH_OneShot - - - - - 083f7015 by Krzysztof Gogolewski at 2023-01-11T00:58:38-05:00 Misc cleanup - Remove unused mkWildEvBinder - Use typeTypeOrConstraint - more symmetric and asserts that that the type is Type or Constraint - Fix escape sequences in Python; they raise a deprecation warning with -Wdefault - - - - - aed1974e by Richard Eisenberg at 2023-01-11T08:30:42+00:00 Refactor the treatment of loopy superclass dicts This patch completely re-engineers how we deal with loopy superclass dictionaries in instance declarations. It fixes #20666 and #19690 The highlights are * Recognise that the loopy-superclass business should use precisely the Paterson conditions. This is much much nicer. See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance * With that in mind, define "Paterson-smaller" in Note [Paterson conditions] in GHC.Tc.Validity, and the new data type `PatersonSize` in GHC.Tc.Utils.TcType, along with functions to compute and compare PatsonSizes * Use the new PatersonSize stuff when solving superclass constraints See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance * In GHC.Tc.Solver.Monad.lookupInInerts, add a missing call to prohibitedSuperClassSolve. This was the original cause of #20666. * Treat (TypeError "stuff") as having PatersonSize zero. See Note [Paterson size for type family applications] in GHC.Tc.Utils.TcType. * Treat the head of a Wanted quantified constraint in the same way as the superclass of an instance decl; this is what fixes #19690. See GHC.Tc.Solver.Canonical Note [Solving a Wanted forall-constraint] (Thanks to Matthew Craven for this insight.) This entailed refactoring the GivenSc constructor of CtOrigin a bit, to say whether it comes from an instance decl or quantified constraint. * Some refactoring way in which redundant constraints are reported; we don't want to complain about the extra, apparently-redundant constraints that we must add to an instance decl because of the loopy-superclass thing. I moved some work from GHC.Tc.Errors to GHC.Tc.Solver. * Add a new section to the user manual to describe the loopy superclass issue and what rules it follows. - - - - - 300bcc15 by HaskellMouse at 2023-01-11T13:43:36-05:00 Parse qualified terms in type signatures This commit allows qualified terms in type signatures to pass the parser and to be cathced by renamer with more informative error message. Adds a few tests. Fixes #21605 - - - - - 964284fc by Simon Peyton Jones at 2023-01-11T13:44:12-05:00 Fix void-arg-adding mechanism for worker/wrapper As #22725 shows, in worker/wrapper we must add the void argument /last/, not first. See GHC.Core.Opt.WorkWrap.Utils Note [Worker/wrapper needs to add void arg last]. That led me to to study GHC.Core.Opt.SpecConstr Note [SpecConstr needs to add void args first] which suggests the opposite! And indeed I think it's the other way round for SpecConstr -- or more precisely the void arg must precede the "extra_bndrs". That led me to some refactoring of GHC.Core.Opt.SpecConstr.calcSpecInfo. - - - - - f7ceafc9 by Krzysztof Gogolewski at 2023-01-11T22:36:59-05:00 Add 'docWithStyle' to improve codegen This new combinator docWithStyle :: IsOutput doc => doc -> (PprStyle -> SDoc) -> doc let us remove the need for code to be polymorphic in HDoc when not used in code style. Metric Decrease: ManyConstructors T13035 T1969 - - - - - b3be0d18 by Simon Peyton Jones at 2023-01-11T22:37:35-05:00 Fix finaliseArgBoxities for OPAQUE function We never do worker wrapper for OPAQUE functions, so we must zap the unboxing info during strictness analysis. This patch fixes #22502 - - - - - db11f358 by Ben Gamari at 2023-01-12T07:49:04-05:00 Revert "rts: Drop racy assertion" The logic here was inverted. Reverting the commit to avoid confusion when examining the commit history. This reverts commit b3eacd64fb36724ed6c5d2d24a81211a161abef1. - - - - - 3242139f by Ben Gamari at 2023-01-12T07:49:04-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 9ffd5d57 by Ben Gamari at 2023-01-12T07:49:41-05:00 configure: Fix escaping of `$tooldir` In !9547 I introduced `$tooldir` directories into GHC's default link and compilation flags to ensure that our C toolchain finds its own headers and libraries before others on the system. However, the patch was subtly wrong in the escaping of `$tooldir`. Fix this. Fixes #22561. - - - - - 905d0b6e by Sebastian Graf at 2023-01-12T15:51:47-05:00 Fix contification with stable unfoldings (#22428) Many functions now return a `TailUsageDetails` that adorns a `UsageDetails` with a `JoinArity` that reflects the number of join point binders around the body for which the `UsageDetails` was computed. `TailUsageDetails` is now returned by `occAnalLamTail` as well as `occAnalUnfolding` and `occAnalRules`. I adjusted `Note [Join points and unfoldings/rules]` and `Note [Adjusting right-hand sides]` to account for the new machinery. I also wrote a new `Note [Join arity prediction based on joinRhsArity]` and refer to it when we combine `TailUsageDetails` for a recursive RHS. I also renamed * `occAnalLam` to `occAnalLamTail` * `adjustRhsUsage` to `adjustTailUsage` * a few other less important functions and properly documented the that each call of `occAnalLamTail` must pair up with `adjustTailUsage`. I removed `Note [Unfoldings and join points]` because it was redundant with `Note [Occurrences in stable unfoldings]`. While in town, I refactored `mkLoopBreakerNodes` so that it returns a condensed `NodeDetails` called `SimpleNodeDetails`. Fixes #22428. The refactoring seems to have quite beneficial effect on ghc/alloc performance: ``` CoOpt_Read(normal) ghc/alloc 784,778,420 768,091,176 -2.1% GOOD T12150(optasm) ghc/alloc 77,762,270 75,986,720 -2.3% GOOD T12425(optasm) ghc/alloc 85,740,186 84,641,712 -1.3% GOOD T13056(optasm) ghc/alloc 306,104,656 299,811,632 -2.1% GOOD T13253(normal) ghc/alloc 350,233,952 346,004,008 -1.2% T14683(normal) ghc/alloc 2,800,514,792 2,754,651,360 -1.6% T15304(normal) ghc/alloc 1,230,883,318 1,215,978,336 -1.2% T15630(normal) ghc/alloc 153,379,590 151,796,488 -1.0% T16577(normal) ghc/alloc 7,356,797,056 7,244,194,416 -1.5% T17516(normal) ghc/alloc 1,718,941,448 1,692,157,288 -1.6% T19695(normal) ghc/alloc 1,485,794,632 1,458,022,112 -1.9% T21839c(normal) ghc/alloc 437,562,314 431,295,896 -1.4% GOOD T21839r(normal) ghc/alloc 446,927,580 440,615,776 -1.4% GOOD geo. mean -0.6% minimum -2.4% maximum -0.0% ``` Metric Decrease: CoOpt_Read T10421 T12150 T12425 T13056 T18698a T18698b T21839c T21839r T9961 - - - - - a1491c87 by Andreas Klebinger at 2023-01-12T15:52:23-05:00 Only gc sparks locally when we can ensure marking is done. When performing GC without work stealing there was no guarantee that spark pruning was happening after marking of the sparks. This could cause us to GC live sparks under certain circumstances. Fixes #22528. - - - - - 8acfe930 by Cheng Shao at 2023-01-12T15:53:00-05:00 Change MSYSTEM to CLANG64 uniformly - - - - - 73bc162b by M Farkas-Dyck at 2023-01-12T15:53:42-05:00 Make `GHC.Tc.Errors.Reporter` take `NonEmpty ErrorItem` rather than `[ErrorItem]`, which lets us drop some panics. Also use the `BasicMismatch` constructor rather than `mkBasicMismatchMsg`, which lets us drop the "-Wno-incomplete-record-updates" flag. - - - - - 1b812b69 by Oleg Grenrus at 2023-01-12T15:54:21-05:00 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general - - - - - c79b2b65 by Matthew Pickering at 2023-01-12T15:54:58-05:00 Don't run hadrian-multi on fast-ci label Fixes #22667 - - - - - 9a3d6add by Bodigrim at 2023-01-13T00:46:36-05:00 Bump submodule bytestring to 0.11.4.0 Metric Decrease: T21839c T21839r - - - - - df33c13c by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Bump Darwin bootstrap toolchain This updates the bootstrap compiler on Darwin from 8.10.7 to 9.2.5, ensuring that we have the fix for #21964. - - - - - 756a66ec by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Pass -w to cabal update Due to cabal#8447, cabal-install 3.8.1.0 requires a compiler to run `cabal update`. - - - - - 1142f858 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump hsc2hs submodule - - - - - d4686729 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump process submodule - - - - - 84ae6573 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: Bump DOCKER_REV - - - - - d53598c5 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: enable xz parallel compression for x64 jobs - - - - - d31fcbca by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: use in-image emsdk for js jobs - - - - - 93b9bbc1 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: improve nix-shell for gen_ci.hs and fix some ghc/hlint warnings - Add a ghc environment including prebuilt dependencies to the nix-shell. Get rid of the ad hoc cabal cache and all dependencies are now downloaded from the nixos binary cache. - Make gen_ci.hs a cabal package with HLS integration, to make future hacking of gen_ci.hs easier. - Fix some ghc/hlint warnings after I got HLS to work. - For the lint-ci-config job, do a shallow clone to save a few minutes of unnecessary git checkout time. - - - - - 8acc56c7 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: source the toolchain env file in wasm jobs - - - - - 87194df0 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: add wasm ci jobs via gen_ci.hs - There is one regular wasm job run in validate pipelines - Additionally, int-native/unreg wasm jobs run in nightly/release pipelines Also, remove the legacy handwritten wasm ci jobs in .gitlab-ci.yml. - - - - - b6eb9bcc by Matthew Pickering at 2023-01-13T11:52:16+00:00 wasm ci: Remove wasm release jobs This removes the wasm release jobs, as we do not yet intend to distribute these binaries. - - - - - 496607fd by Simon Peyton Jones at 2023-01-13T16:52:07-05:00 Add a missing checkEscapingKind Ticket #22743 pointed out that there is a missing check, for type-inferred bindings, that the inferred type doesn't have an escaping kind. The fix is easy. - - - - - 7a9a1042 by Andreas Klebinger at 2023-01-16T20:48:19-05:00 Separate core inlining logic from `Unfolding` type. This seems like a good idea either way, but is mostly motivated by a patch where this avoids a module loop. - - - - - 33b58f77 by sheaf at 2023-01-16T20:48:57-05:00 Hadrian: generalise &%> to avoid warnings This patch introduces a more general version of &%> that works with general traversable shapes, instead of lists. This allows us to pass along the information that the length of the list of filepaths passed to the function exactly matches the length of the input list of filepath patterns, avoiding pattern match warnings. Fixes #22430 - - - - - 8c7a991c by Andreas Klebinger at 2023-01-16T20:49:34-05:00 Add regression test for #22611. A case were a function used to fail to specialize, but now does. - - - - - 6abea760 by Andreas Klebinger at 2023-01-16T20:50:10-05:00 Mark maximumBy/minimumBy as INLINE. The RHS was too large to inline which often prevented the overhead of the Maybe from being optimized away. By marking it as INLINE we can eliminate the overhead of both the maybe and are able to unpack the accumulator when possible. Fixes #22609 - - - - - 99d151bb by Matthew Pickering at 2023-01-16T20:50:50-05:00 ci: Bump CACHE_REV so that ghc-9.6 branch and HEAD have different caches Having the same CACHE_REV on both branches leads to issues where the darwin toolchain is different on ghc-9.6 and HEAD which leads to long darwin build times. In general we should ensure that each branch has a different CACHE_REV. - - - - - 6a5845fb by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in source-tarball job This fixes errors of the form: ``` fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc inferred 9.7.20230113 checking for GHC Git commit id... fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc ``` - - - - - 4afb952c by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't build aarch64-deb10-llvm job on release pipelines Closes #22721 - - - - - 8039feb9 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in test-bootstrap job - - - - - 0b358d0c by Matthew Pickering at 2023-01-16T20:51:25-05:00 rel_eng: Add release engineering scripts into ghc tree It is better to keep these scripts in the tree as they depend on the CI configuration and so on. By keeping them in tree we can keep them up-to-date as the CI config changes and also makes it easier to backport changes to the release script between release branches in future. The final motivation is that it makes generating GHCUp metadata possible. - - - - - 28cb2ed0 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't use complicated image or clone in not-interruptible job This job exists only for the meta-reason of not allowing nightly pipelines to be cancelled. It was taking two minutes to run as in order to run "true" we would also clone the whole GHC repo. - - - - - eeea59bb by Matthew Pickering at 2023-01-16T20:51:26-05:00 Add scripts to generate ghcup metadata on nightly and release pipelines 1. A python script in .gitlab/rel_eng/mk-ghcup-metadata which generates suitable metadata for consumption by GHCUp for the relevant pipelines. - The script generates the metadata just as the ghcup maintainers want, without taking into account platform/library combinations. It is updated manually when the mapping changes. - The script downloads the bindists which ghcup wants to distribute, calculates the hash and generates the yaml in the correct structure. - The script is documented in the .gitlab/rel_eng/mk-ghcup-metadata/README.mk file 1a. The script requires us to understand the mapping from platform -> job. To choose the preferred bindist for each platform the .gitlab/gen_ci.hs script is modified to allow outputting a metadata file which answers the question about which job produces the bindist which we want to distribute to users for a specific platform. 2. Pipelines to run on nightly and release jobs to generate metadata - ghcup-metadata-nightly: Generates metadata which points directly to artifacts in the nightly job. - ghcup-metadata-release: Generates metadata suitable for inclusion directly in ghcup by pointing to the downloads folder where the bindist will be uploaded to. 2a. Trigger jobs which test the generated metadata in the downstream `ghccup-ci` repo. See that repo for documentation about what is tested and how but essentially we test in a variety of clean images that ghcup can download and install the bindists we say exist in our metadata. - - - - - 97bd4d8c by Bodigrim at 2023-01-16T20:52:04-05:00 Bump submodule parsec to 3.1.16.1 - - - - - 97ac8230 by Alan Zimmerman at 2023-01-16T20:52:39-05:00 EPA: Add annotation for 'type' in DataDecl Closes #22765 - - - - - dbbab95d by Ben Gamari at 2023-01-17T06:36:06-05:00 compiler: Small optimisation of assertM In #22739 @AndreasK noticed that assertM performed the action to compute the asserted predicate regardless of whether DEBUG is enabled. This is inconsistent with the other assertion operations and general convention. Fix this. Closes #22739. - - - - - fc02f3bb by Viktor Dukhovni at 2023-01-17T06:36:47-05:00 Avoid unnecessary printf warnings in EventLog.c Fixes #22778 - - - - - 003b6d44 by Simon Peyton Jones at 2023-01-17T16:33:05-05:00 Document the semantics of pattern bindings a bit better This MR is in response to the discussion on #22719 - - - - - f4d50baf by Vladislav Zavialov at 2023-01-17T16:33:41-05:00 Hadrian: fix warnings (#22783) This change fixes the following warnings when building Hadrian: src/Hadrian/Expression.hs:38:10: warning: [-Wredundant-constraints] src/Hadrian/Expression.hs:84:13: warning: [-Wtype-equality-requires-operators] src/Hadrian/Expression.hs:84:21: warning: [-Wtype-equality-requires-operators] src/Hadrian/Haskell/Cabal/Parse.hs:67:1: warning: [-Wunused-imports] - - - - - 06036d93 by Sylvain Henry at 2023-01-18T01:55:10-05:00 testsuite: req_smp --> req_target_smp, req_ghc_smp See #22630 and !9552 This commit: - splits req_smp into req_target_smp and req_ghc_smp - changes the testsuite driver to calculate req_ghc_smp - changes a handful of tests to use req_target_smp instead of req_smp - changes a handful of tests to use req_host_smp when needed The problem: - the problem this solves is the ambiguity surrounding req_smp - on master req_smp was used to express the constraint that the program being compiled supports smp _and_ that the host RTS (i.e., the RTS used to compile the program) supported smp. Normally that is fine, but in cross compilation this is not always the case as was discovered in #22630. The solution: - Differentiate the two constraints: - use req_target_smp to say the RTS the compiled program is linked with (and the platform) supports smp - use req_host_smp to say the RTS the host is linked with supports smp WIP: fix req_smp (target vs ghc) add flag to separate bootstrapper split req_smp -> req_target_smp and req_ghc_smp update tests smp flags cleanup and add some docstrings only set ghc_with_smp to bootstrapper on S1 or CC Only set ghc_with_smp to bootstrapperWithSMP of when testing stage 1 and cross compiling test the RTS in config/ghc not hadrian re-add ghc_with_smp fix and align req names fix T11760 to use req_host_smp test the rts directly, avoid python 3.5 limitation test the compiler in a try block align out of tree and in tree withSMP flags mark failing tests as host req smp testsuite: req_host_smp --> req_ghc_smp Fix ghc vs host, fix ghc_with_smp leftover - - - - - ee9b78aa by Krzysztof Gogolewski at 2023-01-18T01:55:45-05:00 Use -Wdefault when running Python testdriver (#22727) - - - - - e9c0537c by Vladislav Zavialov at 2023-01-18T01:56:22-05:00 Enable -Wstar-is-type by default (#22759) Following the plan in GHC Proposal #143 "Remove the * kind syntax", which states: In the next release (or 3 years in), enable -fwarn-star-is-type by default. The "next release" happens to be 9.6.1 I also moved the T21583 test case from should_fail to should_compile, because the only reason it was failing was -Werror=compat in our test suite configuration. - - - - - 4efee43d by Ryan Scott at 2023-01-18T01:56:59-05:00 Add missing parenthesizeHsType in cvtSigTypeKind We need to ensure that the output of `cvtSigTypeKind` is parenthesized (at precedence `sigPrec`) so that any type signatures with an outermost, explicit kind signature can parse correctly. Fixes #22784. - - - - - f891a442 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. - - - - - b13c6ea5 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. - - - - - c45a5fff by Cheng Shao at 2023-01-18T07:28:37-05:00 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. - - - - - b4c14c4b by Luite Stegeman at 2023-01-18T14:21:42-05:00 Add PrimCallConv support to GHCi This adds support for calling Cmm code from bytecode using the native calling convention, allowing modules that use `foreign import prim` to be loaded and debugged in GHCi. This patch introduces a new `PRIMCALL` bytecode instruction and a helper stack frame `stg_primcall`. The code is based on the existing functionality for dealing with unboxed tuples in bytecode, which has been generalised to handle arbitrary calls. Fixes #22051 - - - - - d0a63ef8 by Adam Gundry at 2023-01-18T14:22:26-05:00 Refactor warning flag parsing to add missing flags This adds `-Werror=<group>` and `-fwarn-<group>` flags for warning groups as well as individual warnings. Previously these were defined on an ad hoc basis so for example we had `-Werror=compat` but not `-Werror=unused-binds`, whereas we had `-fwarn-unused-binds` but not `-fwarn-compat`. Fixes #22182. - - - - - 7ed1b8ef by Adam Gundry at 2023-01-18T14:22:26-05:00 Minor corrections to comments - - - - - 5389681e by Adam Gundry at 2023-01-18T14:22:26-05:00 Revise warnings documentation in user's guide - - - - - ab0d5cda by Adam Gundry at 2023-01-18T14:22:26-05:00 Move documentation of deferred type error flags out of warnings section - - - - - eb5a6b91 by John Ericson at 2023-01-18T22:24:10-05:00 Give the RTS it's own configure script Currently it doesn't do much anything, we are just trying to introduce it without breaking the build. Later, we will move functionality from the top-level configure script over to it. We need to bump Cabal for https://github.com/haskell/cabal/pull/8649; to facilitate and existing hack of skipping some configure checks for the RTS we now need to skip just *part* not *all* of the "post configure" hook, as running the configure script (which we definitely want to do) is also implemented as part of the "post configure" hook. But doing this requires exposing functionality that wasn't exposed before. - - - - - 32ab07bf by Bodigrim at 2023-01-18T22:24:51-05:00 ghc package does not have to depend on terminfo - - - - - 981ff7c4 by Bodigrim at 2023-01-18T22:24:51-05:00 ghc-pkg does not have to depend on terminfo - - - - - f058e367 by Ben Gamari at 2023-01-18T22:25:27-05:00 nativeGen/X86: MFENCE is unnecessary for release semantics In #22764 a user noticed that a program implementing a simple atomic counter via an STRef regressed significantly due to the introduction of necessary atomic operations in the MutVar# primops (#22468). This regression was caused by a bug in the NCG, which emitted an unnecessary MFENCE instruction for a release-ordered atomic write. MFENCE is rather only needed to achieve sequentially consistent ordering. Fixes #22764. - - - - - 154889db by Ryan Scott at 2023-01-18T22:26:03-05:00 Add regression test for #22151 Issue #22151 was coincidentally fixed in commit aed1974e92366ab8e117734f308505684f70cddf (`Refactor the treatment of loopy superclass dicts`). This adds a regression test to ensure that the issue remains fixed. Fixes #22151. - - - - - 14b5982a by Andrei Borzenkov at 2023-01-18T22:26:43-05:00 Fix printing of promoted MkSolo datacon (#22785) Problem: In 2463df2f, the Solo data constructor was renamed to MkSolo, and Solo was turned into a pattern synonym for backwards compatibility. Since pattern synonyms can not be promoted, the old code that pretty-printed promoted single-element tuples started producing ill-typed code: t :: Proxy ('Solo Int) This fails with "Pattern synonym ‘Solo’ used as a type" The solution is to track the distinction between type constructors and data constructors more carefully when printing single-element tuples. - - - - - 1fe806d3 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add hi_core flavour transformer The hi_core flavour transformer enables -fwrite-if-simplified-core for stage1 libraries, which emit core into interface files to make it possible to restart code generation. Building boot libs with it makes it easier to use GHC API to prototype experimental backends that needs core/stg at link time. - - - - - 317cad26 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add missing docs for recently added flavour transformers - - - - - 658f4446 by Ben Gamari at 2023-01-23T04:49:23-05:00 gitlab-ci: Add Rocky8 jobs Addresses #22268. - - - - - a83ec778 by Vladislav Zavialov at 2023-01-23T04:49:58-05:00 Set "since: 9.8" for TypeAbstractions and -Wterm-variable-capture These flags did not make it into the 9.6 release series, so the "since" annotations must be corrected. - - - - - fec7c2ea by Alan Zimmerman at 2023-01-23T04:50:33-05:00 EPA: Add SourceText to HsOverLabel To be able to capture string literals with possible escape codes as labels. Close #22771 - - - - - 3efd1e99 by Ben Gamari at 2023-01-23T04:51:08-05:00 template-haskell: Bump version to 2.20.0.0 Updates `text` and `exceptions` submodules for bounds bumps. Addresses #22767. - - - - - 0900b584 by Cheng Shao at 2023-01-23T04:51:45-05:00 hadrian: disable alloca for in-tree GMP on wasm32 When building in-tree GMP for wasm32, disable its alloca usage, since it may potentially cause stack overflow (e.g. #22602). - - - - - db0f1bfd by Cheng Shao at 2023-01-23T04:52:21-05:00 Bump process submodule Includes a critical fix for wasm32, see https://github.com/haskell/process/pull/272 for details. Also changes the existing cross test to include process stuff and avoid future regression here. - - - - - 9222b167 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Fix subdir for windows bindist - - - - - 9a9bec57 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Remove viPostRemove field from generated metadata This has been removed from the downstream metadata. - - - - - 82884ce0 by Simon Peyton Jones at 2023-01-23T04:53:32-05:00 Fix #22742 runtimeRepLevity_maybe was panicing unnecessarily; and the error printing code made use of the case when it should return Nothing rather than panicing. For some bizarre reason perf/compiler/T21839r shows a 10% bump in runtime peak-megagbytes-used, on a single architecture (alpine). See !9753 for commentary, but I'm going to accept it. Metric Increase: T21839r - - - - - 2c6deb18 by Bryan Richter at 2023-01-23T14:12:22+02:00 codeowners: Add Ben, Matt, and Bryan to CI - - - - - eee3bf05 by Matthew Craven at 2023-01-23T21:46:41-05:00 Do not collect compile-time metrics for T21839r ...the testsuite doesn't handle this properly since it also collects run-time metrics. Compile-time metrics for this test are already tracked via T21839c. Metric Decrease: T21839r - - - - - 1d1dd3fb by Matthew Pickering at 2023-01-24T05:37:52-05:00 Fix recompilation checking for multiple home units The key part of this change is to store a UnitId in the `UsageHomeModule` and `UsageHomeModuleInterface`. * Fine-grained dependency tracking is used if the dependency comes from any home unit. * We actually look up the right module when checking whether we need to recompile in the `UsageHomeModuleInterface` case. These scenarios are both checked by the new tests ( multipleHomeUnits_recomp and multipleHomeUnits_recomp_th ) Fixes #22675 - - - - - 7bfb30f9 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Augment target filepath by working directory when checking if module satisfies target This fixes a spurious warning in -Wmissing-home-modules. This is a simple oversight where when looking for the target in the first place we augment the search by the -working-directory flag but then fail to do so when checking this warning. Fixes #22676 - - - - - 69500dd4 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Use NodeKey rather than ModuleName in pruneCache The `pruneCache` function assumes that the list of `CachedInfo` all have unique `ModuleName`, this is not true: * In normal compilation, the same module name can appear for a file and it's boot file. * In multiple home unit compilation the same ModuleName can appear in different units The fix is to use a `NodeKey` as the actual key for the interfaces which includes `ModuleName`, `IsBoot` and `UnitId`. Fixes #22677 - - - - - 336b2b1c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Recompilation checking: Don't try to find artefacts for Interactive & hs-boot combo In interactive mode we don't produce any linkables for hs-boot files. So we also need to not going looking for them when we check to see if we have all the right objects needed for recompilation. Ticket #22669 - - - - - 6469fea7 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Don't write o-boot files in Interactive mode We should not be producing object files when in interactive mode but we still produced the dummy o-boot files. These never made it into a `Linkable` but then confused the recompilation checker. Fixes #22669 - - - - - 06cc0a95 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Improve driver diagnostic messages by including UnitId in message Currently the driver diagnostics don't give any indication about which unit they correspond to. For example `-Wmissing-home-modules` can fire multiple times for each different home unit and gives no indication about which unit it's actually reporting about. Perhaps a longer term fix is to generalise the providence information away from a SrcSpan so that these kind of whole project errors can be reported with an accurate provenance. For now we can just include the `UnitId` in the error message. Fixes #22678 - - - - - 4fe9eaff by Matthew Pickering at 2023-01-24T05:37:52-05:00 Key ModSummary cache by UnitId as well as FilePath Multiple units can refer to the same files without any problem. Just another assumption which needs to be updated when we may have multiple home units. However, there is the invariant that within each unit each file only maps to one module, so as long as we also key the cache by UnitId then we are all good. This led to some confusing behaviour in GHCi when reloading, multipleHomeUnits_shared distils the essence of what can go wrong. Fixes #22679 - - - - - ada29f5c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Finder: Look in current unit before looking in any home package dependencies In order to preserve existing behaviour it's important to look within the current component before consideirng a module might come from an external component. This already happened by accident in `downsweep`, (because roots are used to repopulated the cache) but in the `Finder` the logic was the wrong way around. Fixes #22680 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp -------------------------p - - - - - be701cc6 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Debug: Print full NodeKey when pretty printing ModuleGraphNode This is helpful when debugging multiple component issues. - - - - - 34d2d463 by Krzysztof Gogolewski at 2023-01-24T05:38:32-05:00 Fix Lint check for duplicate external names Lint was checking for duplicate external names by calling removeDups, which needs a comparison function that is passed to Data.List.sortBy. But the comparison was not a valid ordering - it returned LT if one of the names was not external. For example, the previous implementation won't find a duplicate in [M.x, y, M.x]. Instead, we filter out non-external names before looking for duplicates. - - - - - 1c050ed2 by Matthew Pickering at 2023-01-24T05:39:08-05:00 Add test for T22671 This was fixed by b13c6ea5 Closes #22671 - - - - - 05e6a2d9 by Tom Ellis at 2023-01-24T12:10:52-05:00 Clarify where `f` is defined - - - - - d151546e by Cheng Shao at 2023-01-24T12:11:29-05:00 CmmToC: fix CmmRegOff for 64-bit register on a 32-bit target We used to print the offset value to a platform word sized integer. This is incorrect when the offset is negative (e.g. output of cmm constant folding) and the register is 64-bit but on a 32-bit target, and may lead to incorrect runtime result (e.g. #22607). The fix is simple: just treat it as a proper MO_Add, with the correct width info inferred from the register itself. Metric Increase: T12707 T13379 T4801 T5321FD T5321Fun - - - - - 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 - - - - - 1bd32a35 by Sylvain Henry at 2023-01-26T12:34:21-05:00 Factorize hptModulesBelow Create and use moduleGraphModulesBelow in GHC.Unit.Module.Graph that doesn't need anything from the driver to be used. - - - - - 1262d3f8 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Store dehydrated data structures in CgModBreaks This fixes a tricky leak in GHCi where we were retaining old copies of HscEnvs when reloading. If not all modules were recompiled then these hydrated fields in break points would retain a reference to the old HscEnv which could double memory usage. Fixes #22530 - - - - - e27eb80c by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force more in NFData Name instance Doesn't force the lazy `OccName` field (#19619) which is already known as a really bad source of leaks. When we slam the hammer storing Names on disk (in interface files or the like), all this should be forced as otherwise a `Name` can easily retain an `Id` and hence the entire world. Fixes #22833 - - - - - 3d004d5a by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force OccName in tidyTopName This occname has just been derived from an `Id`, so need to force it promptly so we can release the Id back to the world. Another symptom of the bug caused by #19619 - - - - - f2a0fea0 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Strict fields in ModNodeKey (otherwise retains HomeModInfo) Towards #22530 - - - - - 5640cb1d by Sylvain Henry at 2023-01-26T12:35:36-05:00 Hadrian: fix doc generation Was missing dependencies on files generated by templates (e.g. ghc.cabal) - - - - - 3e827c3f by Richard Eisenberg at 2023-01-26T20:06:53-05:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. - - - - - b3ef5c89 by doyougnu at 2023-01-26T20:07:48-05:00 tryFillBuffer: strictify more speculative bangs - - - - - d0d7ba0f by Vladislav Zavialov at 2023-01-26T20:08:25-05:00 base: NoImplicitPrelude in Data.Void and Data.Kind This change removes an unnecessary dependency on Prelude from two modules in the base package. - - - - - fa1db923 by Matthew Pickering at 2023-01-26T20:09:00-05: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 - - - - - 807310a1 by Matthew Pickering at 2023-01-26T20:09:00-05:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. - - - - - c7116b10 by Ben Gamari at 2023-01-26T20:09:35-05:00 base: Make changelog proposal references more consistent Addresses #22773. - - - - - 6932cfc7 by Sylvain Henry at 2023-01-26T20:10:27-05:00 Fix spurious change from !9568 - - - - - e480fbc2 by Ben Gamari at 2023-01-27T05:01:24-05:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 - - - - - 2648c09c by Andrei Borzenkov at 2023-01-27T05:02:07-05:00 Replace errors from badOrigBinding with new one (#22839) Problem: in 02279a9c the type-level [] syntax was changed from a built-in name to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if a name is not built-in then it must have come from TH quotation, but this is not necessarily the case with []. The outdated assumption in badOrigBinding leads to incorrect error messages. This code: data [] Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []" Unfortunately, there is not enough information in RdrName to directly determine if the name was constructed via TH or by the parser, so this patch changes the error message instead. It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote into a new error TcRnBindingOfExistingName and changes its wording to avoid guessing the origin of the name. - - - - - 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - b96530be by Ben Gamari at 2023-02-01T13:42:20-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 13 changed files: - − .appveyor.sh - .editorconfig - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/nix/sources.json - .gitlab/darwin/toolchain.nix - + .gitlab/gen-ci.cabal - + .gitlab/gen_ci.hs - + .gitlab/generate_job_metadata - + .gitlab/generate_jobs - + .gitlab/hello.hs - + .gitlab/hie.yaml The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/455c847c14d22b435a465376e5d796e4140e8d4f...b96530bedd6749fbcdd2d81abbd59a4a50bb4b58 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/455c847c14d22b435a465376e5d796e4140e8d4f...b96530bedd6749fbcdd2d81abbd59a4a50bb4b58 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 1 19:33:27 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 01 Feb 2023 14:33:27 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Treat existentials correctly in dubiousDataConInstArgTys Message-ID: <63dabe876237c_2a4f463a684414683a3@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - d4b4edd1 by Matthew Pickering at 2023-02-01T14:33:12-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 586646a4 by Teo Camarasu at 2023-02-01T14:33:16-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 8 changed files: - .gitlab-ci.yml - compiler/GHC.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - configure.ac - libraries/base/GHC/Stats.hsc - llvm-passes - + testsuite/tests/simplCore/should_compile/T22849.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: 2d59d551647d102c4af44f257c520a94f04ea3f6 + DOCKER_REV: 572353e0644044fe3a5465bba4342a9a0b0eb60e # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. ===================================== compiler/GHC.hs ===================================== @@ -3,7 +3,6 @@ {-# LANGUAGE TupleSections, NamedFieldPuns #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TypeFamilies #-} -{-# OPTIONS_GHC -ddump-stg-final -ddump-to-file #-} -- ----------------------------------------------------------------------------- -- ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -707,7 +707,7 @@ Worker/wrapper will unbox * is an algebraic data type (not a newtype) * is not recursive (as per 'isRecDataCon') * has a single constructor (thus is a "product") - * that may bind existentials + * that may bind existentials (#18982) We can transform > data D a = forall b. D a b > f (D @ex a b) = e @@ -1272,16 +1272,25 @@ also unbox its components. That is governed by the `usefulSplit` mechanism. -} -- | Exactly 'dataConInstArgTys', but lacks the (ASSERT'ed) precondition that --- the 'DataCon' may not have existentials. The lack of cloning the existentials --- compared to 'dataConInstExAndArgVars' makes this function \"dubious\"; --- only use it where type variables aren't substituted for! +-- the 'DataCon' may not have existentials. The lack of cloning the +-- existentials this function \"dubious\"; only use it where type variables +-- aren't substituted for! Why may the data con bind existentials? +-- See Note [Which types are unboxed?] dubiousDataConInstArgTys :: DataCon -> [Type] -> [Type] dubiousDataConInstArgTys dc tc_args = arg_tys where - univ_tvs = dataConUnivTyVars dc - ex_tvs = dataConExTyCoVars dc - subst = extendSubstInScopeList (zipTvSubst univ_tvs tc_args) ex_tvs - arg_tys = map (GHC.Core.Type.substTy subst . scaledThing) (dataConRepArgTys dc) + univ_tvs = dataConUnivTyVars dc + ex_tvs = dataConExTyCoVars dc + univ_subst = zipTvSubst univ_tvs tc_args + (full_subst, _) = substTyVarBndrs univ_subst ex_tvs + arg_tys = map (substTy full_subst . scaledThing) $ + dataConRepArgTys dc + -- NB: use substTyVarBndrs on ex_tvs to ensure that we + -- substitute in their kinds. For example (#22849) + -- Consider data T a where + -- MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a + -- Then dubiousDataConInstArgTys MkT [Type, Foo] should return + -- [Foo (ix::Type)], not [Foo (ix::k)]! findTypeShape :: FamInstEnvs -> Type -> TypeShape -- Uncover the arrow and product shape of a type ===================================== configure.ac ===================================== @@ -554,8 +554,8 @@ AC_SUBST(InstallNameToolCmd) # tools we are looking for. In the past, GHC supported a number of # versions of LLVM simultaneously, but that stopped working around # 3.5/3.6 release of LLVM. -LlvmMinVersion=10 # inclusive -LlvmMaxVersion=15 # not inclusive +LlvmMinVersion=11 # inclusive +LlvmMaxVersion=16 # not inclusive AC_SUBST([LlvmMinVersion]) AC_SUBST([LlvmMaxVersion]) sUPPORTED_LLVM_VERSION_MIN=$(echo \($LlvmMinVersion\) | sed 's/\./,/') ===================================== libraries/base/GHC/Stats.hsc ===================================== @@ -162,7 +162,8 @@ data GCDetails = GCDetails { -- | The amount of memory lost due to block fragmentation in bytes. -- Block fragmentation is the difference between the amount of blocks retained by the RTS and the blocks that are in use. -- This occurs when megablocks are only sparsely used, eg, when data that cannot be moved retains a megablock. - -- @since 4.17.0.0 + -- + -- @since 4.18.0.0 , gcdetails_block_fragmentation_bytes :: Word64 -- | The time elapsed during synchronisation before GC , gcdetails_sync_elapsed_ns :: RtsTime ===================================== llvm-passes ===================================== @@ -1,5 +1,5 @@ [ -(0, "-mem2reg -globalopt -lower-expect"), -(1, "-O1 -globalopt"), -(2, "-O2") +(0, "-enable-new-pm=0 -mem2reg -globalopt -lower-expect"), +(1, "-enable-new-pm=0 -O1 -globalopt"), +(2, "-enable-new-pm=0 -O2") ] ===================================== testsuite/tests/simplCore/should_compile/T22849.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE GADTs #-} + +module T22849 where + +data Foo a where + Foo :: Foo Int + +data Bar a = Bar a (Foo a) + +data Some t = forall ix. Some (t ix) + +instance Show (Some Bar) where + show (Some (Bar v t)) = case t of + Foo -> show v ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -453,7 +453,7 @@ test('T22375', normal, compile, ['-O -ddump-simpl -dsuppress-uniques -dno-typeab test('T21851_2', [grep_errmsg(r'wwombat') ], multimod_compile, ['T21851_2', '-O -dno-typeable-binds -dsuppress-uniques']) # Should not inline m, so there shouldn't be a single YES test('T22317', [grep_errmsg(r'ANSWER = YES') ], compile, ['-O -dinline-check m -ddebug-output']) - +test('T22849', normal, compile, ['-O']) test('T22634', normal, compile, ['-O -fcatch-nonexhaustive-cases']) test('T22494', [grep_errmsg(r'case') ], compile, ['-O -ddump-simpl -dsuppress-uniques']) test('T22491', normal, compile, ['-O2']) @@ -472,3 +472,4 @@ test('T22611', [when(wordsize(32), skip), grep_errmsg(r'\$salterF') ], compile, test('T22715_2', normal, multimod_compile, ['T22715_2', '-v0 -O -fspecialise-aggressively']) test('T22802', normal, compile, ['-O']) test('T15205', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/407703c34ffb649bbcf87a3218304342fd48ac16...586646a4d0e86cbf6b563fc6ab58d08f54ea3052 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/407703c34ffb649bbcf87a3218304342fd48ac16...586646a4d0e86cbf6b563fc6ab58d08f54ea3052 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 1 22:11:16 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 01 Feb 2023 17:11:16 -0500 Subject: [Git][ghc/ghc][wip/T22404] 163 commits: Bump hsc2hs submodule Message-ID: <63dae3844248_2a4f55fdc14974e9@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 1142f858 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump hsc2hs submodule - - - - - d4686729 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump process submodule - - - - - 84ae6573 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: Bump DOCKER_REV - - - - - d53598c5 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: enable xz parallel compression for x64 jobs - - - - - d31fcbca by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: use in-image emsdk for js jobs - - - - - 93b9bbc1 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: improve nix-shell for gen_ci.hs and fix some ghc/hlint warnings - Add a ghc environment including prebuilt dependencies to the nix-shell. Get rid of the ad hoc cabal cache and all dependencies are now downloaded from the nixos binary cache. - Make gen_ci.hs a cabal package with HLS integration, to make future hacking of gen_ci.hs easier. - Fix some ghc/hlint warnings after I got HLS to work. - For the lint-ci-config job, do a shallow clone to save a few minutes of unnecessary git checkout time. - - - - - 8acc56c7 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: source the toolchain env file in wasm jobs - - - - - 87194df0 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: add wasm ci jobs via gen_ci.hs - There is one regular wasm job run in validate pipelines - Additionally, int-native/unreg wasm jobs run in nightly/release pipelines Also, remove the legacy handwritten wasm ci jobs in .gitlab-ci.yml. - - - - - b6eb9bcc by Matthew Pickering at 2023-01-13T11:52:16+00:00 wasm ci: Remove wasm release jobs This removes the wasm release jobs, as we do not yet intend to distribute these binaries. - - - - - 496607fd by Simon Peyton Jones at 2023-01-13T16:52:07-05:00 Add a missing checkEscapingKind Ticket #22743 pointed out that there is a missing check, for type-inferred bindings, that the inferred type doesn't have an escaping kind. The fix is easy. - - - - - 7a9a1042 by Andreas Klebinger at 2023-01-16T20:48:19-05:00 Separate core inlining logic from `Unfolding` type. This seems like a good idea either way, but is mostly motivated by a patch where this avoids a module loop. - - - - - 33b58f77 by sheaf at 2023-01-16T20:48:57-05:00 Hadrian: generalise &%> to avoid warnings This patch introduces a more general version of &%> that works with general traversable shapes, instead of lists. This allows us to pass along the information that the length of the list of filepaths passed to the function exactly matches the length of the input list of filepath patterns, avoiding pattern match warnings. Fixes #22430 - - - - - 8c7a991c by Andreas Klebinger at 2023-01-16T20:49:34-05:00 Add regression test for #22611. A case were a function used to fail to specialize, but now does. - - - - - 6abea760 by Andreas Klebinger at 2023-01-16T20:50:10-05:00 Mark maximumBy/minimumBy as INLINE. The RHS was too large to inline which often prevented the overhead of the Maybe from being optimized away. By marking it as INLINE we can eliminate the overhead of both the maybe and are able to unpack the accumulator when possible. Fixes #22609 - - - - - 99d151bb by Matthew Pickering at 2023-01-16T20:50:50-05:00 ci: Bump CACHE_REV so that ghc-9.6 branch and HEAD have different caches Having the same CACHE_REV on both branches leads to issues where the darwin toolchain is different on ghc-9.6 and HEAD which leads to long darwin build times. In general we should ensure that each branch has a different CACHE_REV. - - - - - 6a5845fb by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in source-tarball job This fixes errors of the form: ``` fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc inferred 9.7.20230113 checking for GHC Git commit id... fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc ``` - - - - - 4afb952c by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't build aarch64-deb10-llvm job on release pipelines Closes #22721 - - - - - 8039feb9 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in test-bootstrap job - - - - - 0b358d0c by Matthew Pickering at 2023-01-16T20:51:25-05:00 rel_eng: Add release engineering scripts into ghc tree It is better to keep these scripts in the tree as they depend on the CI configuration and so on. By keeping them in tree we can keep them up-to-date as the CI config changes and also makes it easier to backport changes to the release script between release branches in future. The final motivation is that it makes generating GHCUp metadata possible. - - - - - 28cb2ed0 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't use complicated image or clone in not-interruptible job This job exists only for the meta-reason of not allowing nightly pipelines to be cancelled. It was taking two minutes to run as in order to run "true" we would also clone the whole GHC repo. - - - - - eeea59bb by Matthew Pickering at 2023-01-16T20:51:26-05:00 Add scripts to generate ghcup metadata on nightly and release pipelines 1. A python script in .gitlab/rel_eng/mk-ghcup-metadata which generates suitable metadata for consumption by GHCUp for the relevant pipelines. - The script generates the metadata just as the ghcup maintainers want, without taking into account platform/library combinations. It is updated manually when the mapping changes. - The script downloads the bindists which ghcup wants to distribute, calculates the hash and generates the yaml in the correct structure. - The script is documented in the .gitlab/rel_eng/mk-ghcup-metadata/README.mk file 1a. The script requires us to understand the mapping from platform -> job. To choose the preferred bindist for each platform the .gitlab/gen_ci.hs script is modified to allow outputting a metadata file which answers the question about which job produces the bindist which we want to distribute to users for a specific platform. 2. Pipelines to run on nightly and release jobs to generate metadata - ghcup-metadata-nightly: Generates metadata which points directly to artifacts in the nightly job. - ghcup-metadata-release: Generates metadata suitable for inclusion directly in ghcup by pointing to the downloads folder where the bindist will be uploaded to. 2a. Trigger jobs which test the generated metadata in the downstream `ghccup-ci` repo. See that repo for documentation about what is tested and how but essentially we test in a variety of clean images that ghcup can download and install the bindists we say exist in our metadata. - - - - - 97bd4d8c by Bodigrim at 2023-01-16T20:52:04-05:00 Bump submodule parsec to 3.1.16.1 - - - - - 97ac8230 by Alan Zimmerman at 2023-01-16T20:52:39-05:00 EPA: Add annotation for 'type' in DataDecl Closes #22765 - - - - - dbbab95d by Ben Gamari at 2023-01-17T06:36:06-05:00 compiler: Small optimisation of assertM In #22739 @AndreasK noticed that assertM performed the action to compute the asserted predicate regardless of whether DEBUG is enabled. This is inconsistent with the other assertion operations and general convention. Fix this. Closes #22739. - - - - - fc02f3bb by Viktor Dukhovni at 2023-01-17T06:36:47-05:00 Avoid unnecessary printf warnings in EventLog.c Fixes #22778 - - - - - 003b6d44 by Simon Peyton Jones at 2023-01-17T16:33:05-05:00 Document the semantics of pattern bindings a bit better This MR is in response to the discussion on #22719 - - - - - f4d50baf by Vladislav Zavialov at 2023-01-17T16:33:41-05:00 Hadrian: fix warnings (#22783) This change fixes the following warnings when building Hadrian: src/Hadrian/Expression.hs:38:10: warning: [-Wredundant-constraints] src/Hadrian/Expression.hs:84:13: warning: [-Wtype-equality-requires-operators] src/Hadrian/Expression.hs:84:21: warning: [-Wtype-equality-requires-operators] src/Hadrian/Haskell/Cabal/Parse.hs:67:1: warning: [-Wunused-imports] - - - - - 06036d93 by Sylvain Henry at 2023-01-18T01:55:10-05:00 testsuite: req_smp --> req_target_smp, req_ghc_smp See #22630 and !9552 This commit: - splits req_smp into req_target_smp and req_ghc_smp - changes the testsuite driver to calculate req_ghc_smp - changes a handful of tests to use req_target_smp instead of req_smp - changes a handful of tests to use req_host_smp when needed The problem: - the problem this solves is the ambiguity surrounding req_smp - on master req_smp was used to express the constraint that the program being compiled supports smp _and_ that the host RTS (i.e., the RTS used to compile the program) supported smp. Normally that is fine, but in cross compilation this is not always the case as was discovered in #22630. The solution: - Differentiate the two constraints: - use req_target_smp to say the RTS the compiled program is linked with (and the platform) supports smp - use req_host_smp to say the RTS the host is linked with supports smp WIP: fix req_smp (target vs ghc) add flag to separate bootstrapper split req_smp -> req_target_smp and req_ghc_smp update tests smp flags cleanup and add some docstrings only set ghc_with_smp to bootstrapper on S1 or CC Only set ghc_with_smp to bootstrapperWithSMP of when testing stage 1 and cross compiling test the RTS in config/ghc not hadrian re-add ghc_with_smp fix and align req names fix T11760 to use req_host_smp test the rts directly, avoid python 3.5 limitation test the compiler in a try block align out of tree and in tree withSMP flags mark failing tests as host req smp testsuite: req_host_smp --> req_ghc_smp Fix ghc vs host, fix ghc_with_smp leftover - - - - - ee9b78aa by Krzysztof Gogolewski at 2023-01-18T01:55:45-05:00 Use -Wdefault when running Python testdriver (#22727) - - - - - e9c0537c by Vladislav Zavialov at 2023-01-18T01:56:22-05:00 Enable -Wstar-is-type by default (#22759) Following the plan in GHC Proposal #143 "Remove the * kind syntax", which states: In the next release (or 3 years in), enable -fwarn-star-is-type by default. The "next release" happens to be 9.6.1 I also moved the T21583 test case from should_fail to should_compile, because the only reason it was failing was -Werror=compat in our test suite configuration. - - - - - 4efee43d by Ryan Scott at 2023-01-18T01:56:59-05:00 Add missing parenthesizeHsType in cvtSigTypeKind We need to ensure that the output of `cvtSigTypeKind` is parenthesized (at precedence `sigPrec`) so that any type signatures with an outermost, explicit kind signature can parse correctly. Fixes #22784. - - - - - f891a442 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. - - - - - b13c6ea5 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. - - - - - c45a5fff by Cheng Shao at 2023-01-18T07:28:37-05:00 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. - - - - - b4c14c4b by Luite Stegeman at 2023-01-18T14:21:42-05:00 Add PrimCallConv support to GHCi This adds support for calling Cmm code from bytecode using the native calling convention, allowing modules that use `foreign import prim` to be loaded and debugged in GHCi. This patch introduces a new `PRIMCALL` bytecode instruction and a helper stack frame `stg_primcall`. The code is based on the existing functionality for dealing with unboxed tuples in bytecode, which has been generalised to handle arbitrary calls. Fixes #22051 - - - - - d0a63ef8 by Adam Gundry at 2023-01-18T14:22:26-05:00 Refactor warning flag parsing to add missing flags This adds `-Werror=<group>` and `-fwarn-<group>` flags for warning groups as well as individual warnings. Previously these were defined on an ad hoc basis so for example we had `-Werror=compat` but not `-Werror=unused-binds`, whereas we had `-fwarn-unused-binds` but not `-fwarn-compat`. Fixes #22182. - - - - - 7ed1b8ef by Adam Gundry at 2023-01-18T14:22:26-05:00 Minor corrections to comments - - - - - 5389681e by Adam Gundry at 2023-01-18T14:22:26-05:00 Revise warnings documentation in user's guide - - - - - ab0d5cda by Adam Gundry at 2023-01-18T14:22:26-05:00 Move documentation of deferred type error flags out of warnings section - - - - - eb5a6b91 by John Ericson at 2023-01-18T22:24:10-05:00 Give the RTS it's own configure script Currently it doesn't do much anything, we are just trying to introduce it without breaking the build. Later, we will move functionality from the top-level configure script over to it. We need to bump Cabal for https://github.com/haskell/cabal/pull/8649; to facilitate and existing hack of skipping some configure checks for the RTS we now need to skip just *part* not *all* of the "post configure" hook, as running the configure script (which we definitely want to do) is also implemented as part of the "post configure" hook. But doing this requires exposing functionality that wasn't exposed before. - - - - - 32ab07bf by Bodigrim at 2023-01-18T22:24:51-05:00 ghc package does not have to depend on terminfo - - - - - 981ff7c4 by Bodigrim at 2023-01-18T22:24:51-05:00 ghc-pkg does not have to depend on terminfo - - - - - f058e367 by Ben Gamari at 2023-01-18T22:25:27-05:00 nativeGen/X86: MFENCE is unnecessary for release semantics In #22764 a user noticed that a program implementing a simple atomic counter via an STRef regressed significantly due to the introduction of necessary atomic operations in the MutVar# primops (#22468). This regression was caused by a bug in the NCG, which emitted an unnecessary MFENCE instruction for a release-ordered atomic write. MFENCE is rather only needed to achieve sequentially consistent ordering. Fixes #22764. - - - - - 154889db by Ryan Scott at 2023-01-18T22:26:03-05:00 Add regression test for #22151 Issue #22151 was coincidentally fixed in commit aed1974e92366ab8e117734f308505684f70cddf (`Refactor the treatment of loopy superclass dicts`). This adds a regression test to ensure that the issue remains fixed. Fixes #22151. - - - - - 14b5982a by Andrei Borzenkov at 2023-01-18T22:26:43-05:00 Fix printing of promoted MkSolo datacon (#22785) Problem: In 2463df2f, the Solo data constructor was renamed to MkSolo, and Solo was turned into a pattern synonym for backwards compatibility. Since pattern synonyms can not be promoted, the old code that pretty-printed promoted single-element tuples started producing ill-typed code: t :: Proxy ('Solo Int) This fails with "Pattern synonym ‘Solo’ used as a type" The solution is to track the distinction between type constructors and data constructors more carefully when printing single-element tuples. - - - - - 1fe806d3 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add hi_core flavour transformer The hi_core flavour transformer enables -fwrite-if-simplified-core for stage1 libraries, which emit core into interface files to make it possible to restart code generation. Building boot libs with it makes it easier to use GHC API to prototype experimental backends that needs core/stg at link time. - - - - - 317cad26 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add missing docs for recently added flavour transformers - - - - - 658f4446 by Ben Gamari at 2023-01-23T04:49:23-05:00 gitlab-ci: Add Rocky8 jobs Addresses #22268. - - - - - a83ec778 by Vladislav Zavialov at 2023-01-23T04:49:58-05:00 Set "since: 9.8" for TypeAbstractions and -Wterm-variable-capture These flags did not make it into the 9.6 release series, so the "since" annotations must be corrected. - - - - - fec7c2ea by Alan Zimmerman at 2023-01-23T04:50:33-05:00 EPA: Add SourceText to HsOverLabel To be able to capture string literals with possible escape codes as labels. Close #22771 - - - - - 3efd1e99 by Ben Gamari at 2023-01-23T04:51:08-05:00 template-haskell: Bump version to 2.20.0.0 Updates `text` and `exceptions` submodules for bounds bumps. Addresses #22767. - - - - - 0900b584 by Cheng Shao at 2023-01-23T04:51:45-05:00 hadrian: disable alloca for in-tree GMP on wasm32 When building in-tree GMP for wasm32, disable its alloca usage, since it may potentially cause stack overflow (e.g. #22602). - - - - - db0f1bfd by Cheng Shao at 2023-01-23T04:52:21-05:00 Bump process submodule Includes a critical fix for wasm32, see https://github.com/haskell/process/pull/272 for details. Also changes the existing cross test to include process stuff and avoid future regression here. - - - - - 9222b167 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Fix subdir for windows bindist - - - - - 9a9bec57 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Remove viPostRemove field from generated metadata This has been removed from the downstream metadata. - - - - - 82884ce0 by Simon Peyton Jones at 2023-01-23T04:53:32-05:00 Fix #22742 runtimeRepLevity_maybe was panicing unnecessarily; and the error printing code made use of the case when it should return Nothing rather than panicing. For some bizarre reason perf/compiler/T21839r shows a 10% bump in runtime peak-megagbytes-used, on a single architecture (alpine). See !9753 for commentary, but I'm going to accept it. Metric Increase: T21839r - - - - - 2c6deb18 by Bryan Richter at 2023-01-23T14:12:22+02:00 codeowners: Add Ben, Matt, and Bryan to CI - - - - - eee3bf05 by Matthew Craven at 2023-01-23T21:46:41-05:00 Do not collect compile-time metrics for T21839r ...the testsuite doesn't handle this properly since it also collects run-time metrics. Compile-time metrics for this test are already tracked via T21839c. Metric Decrease: T21839r - - - - - 1d1dd3fb by Matthew Pickering at 2023-01-24T05:37:52-05:00 Fix recompilation checking for multiple home units The key part of this change is to store a UnitId in the `UsageHomeModule` and `UsageHomeModuleInterface`. * Fine-grained dependency tracking is used if the dependency comes from any home unit. * We actually look up the right module when checking whether we need to recompile in the `UsageHomeModuleInterface` case. These scenarios are both checked by the new tests ( multipleHomeUnits_recomp and multipleHomeUnits_recomp_th ) Fixes #22675 - - - - - 7bfb30f9 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Augment target filepath by working directory when checking if module satisfies target This fixes a spurious warning in -Wmissing-home-modules. This is a simple oversight where when looking for the target in the first place we augment the search by the -working-directory flag but then fail to do so when checking this warning. Fixes #22676 - - - - - 69500dd4 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Use NodeKey rather than ModuleName in pruneCache The `pruneCache` function assumes that the list of `CachedInfo` all have unique `ModuleName`, this is not true: * In normal compilation, the same module name can appear for a file and it's boot file. * In multiple home unit compilation the same ModuleName can appear in different units The fix is to use a `NodeKey` as the actual key for the interfaces which includes `ModuleName`, `IsBoot` and `UnitId`. Fixes #22677 - - - - - 336b2b1c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Recompilation checking: Don't try to find artefacts for Interactive & hs-boot combo In interactive mode we don't produce any linkables for hs-boot files. So we also need to not going looking for them when we check to see if we have all the right objects needed for recompilation. Ticket #22669 - - - - - 6469fea7 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Don't write o-boot files in Interactive mode We should not be producing object files when in interactive mode but we still produced the dummy o-boot files. These never made it into a `Linkable` but then confused the recompilation checker. Fixes #22669 - - - - - 06cc0a95 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Improve driver diagnostic messages by including UnitId in message Currently the driver diagnostics don't give any indication about which unit they correspond to. For example `-Wmissing-home-modules` can fire multiple times for each different home unit and gives no indication about which unit it's actually reporting about. Perhaps a longer term fix is to generalise the providence information away from a SrcSpan so that these kind of whole project errors can be reported with an accurate provenance. For now we can just include the `UnitId` in the error message. Fixes #22678 - - - - - 4fe9eaff by Matthew Pickering at 2023-01-24T05:37:52-05:00 Key ModSummary cache by UnitId as well as FilePath Multiple units can refer to the same files without any problem. Just another assumption which needs to be updated when we may have multiple home units. However, there is the invariant that within each unit each file only maps to one module, so as long as we also key the cache by UnitId then we are all good. This led to some confusing behaviour in GHCi when reloading, multipleHomeUnits_shared distils the essence of what can go wrong. Fixes #22679 - - - - - ada29f5c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Finder: Look in current unit before looking in any home package dependencies In order to preserve existing behaviour it's important to look within the current component before consideirng a module might come from an external component. This already happened by accident in `downsweep`, (because roots are used to repopulated the cache) but in the `Finder` the logic was the wrong way around. Fixes #22680 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp -------------------------p - - - - - be701cc6 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Debug: Print full NodeKey when pretty printing ModuleGraphNode This is helpful when debugging multiple component issues. - - - - - 34d2d463 by Krzysztof Gogolewski at 2023-01-24T05:38:32-05:00 Fix Lint check for duplicate external names Lint was checking for duplicate external names by calling removeDups, which needs a comparison function that is passed to Data.List.sortBy. But the comparison was not a valid ordering - it returned LT if one of the names was not external. For example, the previous implementation won't find a duplicate in [M.x, y, M.x]. Instead, we filter out non-external names before looking for duplicates. - - - - - 1c050ed2 by Matthew Pickering at 2023-01-24T05:39:08-05:00 Add test for T22671 This was fixed by b13c6ea5 Closes #22671 - - - - - 05e6a2d9 by Tom Ellis at 2023-01-24T12:10:52-05:00 Clarify where `f` is defined - - - - - d151546e by Cheng Shao at 2023-01-24T12:11:29-05:00 CmmToC: fix CmmRegOff for 64-bit register on a 32-bit target We used to print the offset value to a platform word sized integer. This is incorrect when the offset is negative (e.g. output of cmm constant folding) and the register is 64-bit but on a 32-bit target, and may lead to incorrect runtime result (e.g. #22607). The fix is simple: just treat it as a proper MO_Add, with the correct width info inferred from the register itself. Metric Increase: T12707 T13379 T4801 T5321FD T5321Fun - - - - - 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 - - - - - 1bd32a35 by Sylvain Henry at 2023-01-26T12:34:21-05:00 Factorize hptModulesBelow Create and use moduleGraphModulesBelow in GHC.Unit.Module.Graph that doesn't need anything from the driver to be used. - - - - - 1262d3f8 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Store dehydrated data structures in CgModBreaks This fixes a tricky leak in GHCi where we were retaining old copies of HscEnvs when reloading. If not all modules were recompiled then these hydrated fields in break points would retain a reference to the old HscEnv which could double memory usage. Fixes #22530 - - - - - e27eb80c by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force more in NFData Name instance Doesn't force the lazy `OccName` field (#19619) which is already known as a really bad source of leaks. When we slam the hammer storing Names on disk (in interface files or the like), all this should be forced as otherwise a `Name` can easily retain an `Id` and hence the entire world. Fixes #22833 - - - - - 3d004d5a by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force OccName in tidyTopName This occname has just been derived from an `Id`, so need to force it promptly so we can release the Id back to the world. Another symptom of the bug caused by #19619 - - - - - f2a0fea0 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Strict fields in ModNodeKey (otherwise retains HomeModInfo) Towards #22530 - - - - - 5640cb1d by Sylvain Henry at 2023-01-26T12:35:36-05:00 Hadrian: fix doc generation Was missing dependencies on files generated by templates (e.g. ghc.cabal) - - - - - 3e827c3f by Richard Eisenberg at 2023-01-26T20:06:53-05:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. - - - - - b3ef5c89 by doyougnu at 2023-01-26T20:07:48-05:00 tryFillBuffer: strictify more speculative bangs - - - - - d0d7ba0f by Vladislav Zavialov at 2023-01-26T20:08:25-05:00 base: NoImplicitPrelude in Data.Void and Data.Kind This change removes an unnecessary dependency on Prelude from two modules in the base package. - - - - - fa1db923 by Matthew Pickering at 2023-01-26T20:09:00-05: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 - - - - - 807310a1 by Matthew Pickering at 2023-01-26T20:09:00-05:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. - - - - - c7116b10 by Ben Gamari at 2023-01-26T20:09:35-05:00 base: Make changelog proposal references more consistent Addresses #22773. - - - - - 6932cfc7 by Sylvain Henry at 2023-01-26T20:10:27-05:00 Fix spurious change from !9568 - - - - - e480fbc2 by Ben Gamari at 2023-01-27T05:01:24-05:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 - - - - - 2648c09c by Andrei Borzenkov at 2023-01-27T05:02:07-05:00 Replace errors from badOrigBinding with new one (#22839) Problem: in 02279a9c the type-level [] syntax was changed from a built-in name to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if a name is not built-in then it must have come from TH quotation, but this is not necessarily the case with []. The outdated assumption in badOrigBinding leads to incorrect error messages. This code: data [] Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []" Unfortunately, there is not enough information in RdrName to directly determine if the name was constructed via TH or by the parser, so this patch changes the error message instead. It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote into a new error TcRnBindingOfExistingName and changes its wording to avoid guessing the origin of the name. - - - - - 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 101ec437 by Simon Peyton Jones at 2023-02-01T20:14:50+00:00 Work in progress on #22404 Very much not ready! - - - - - 7fa50a66 by Sebastian Graf at 2023-02-01T20:14:50+00:00 Partition into OneOccs and ManyOccs - - - - - 6f619f6e by Simon Peyton Jones at 2023-02-01T20:14:50+00:00 Wibbles - - - - - 107a54f8 by Simon Peyton Jones at 2023-02-01T20:14:50+00:00 Refactor WithTailJoinDetails - - - - - a70b1692 by Simon Peyton Jones at 2023-02-01T22:11:47+00:00 Wibbles - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - + .gitlab/gen-ci.cabal - .gitlab/gen_ci.hs - + .gitlab/generate_job_metadata - .gitlab/generate_jobs - .gitlab/hello.hs - + .gitlab/hie.yaml - .gitlab/jobs.yaml - + .gitlab/rel_eng/default.nix - + .gitlab/rel_eng/fetch-gitlab-artifacts/.gitignore - + .gitlab/rel_eng/fetch-gitlab-artifacts/README.mkd - + .gitlab/rel_eng/fetch-gitlab-artifacts/default.nix - + .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - + .gitlab/rel_eng/fetch-gitlab-artifacts/setup.py - + .gitlab/rel_eng/mk-ghcup-metadata/.gitignore - + .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - + .gitlab/rel_eng/mk-ghcup-metadata/default.nix - + .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - + .gitlab/rel_eng/mk-ghcup-metadata/setup.py - + .gitlab/rel_eng/nix/sources.json - + .gitlab/rel_eng/nix/sources.nix - + .gitlab/rel_eng/upload.sh - .gitlab/upload_ghc_libs.py → .gitlab/rel_eng/upload_ghc_libs.py - CODEOWNERS - INSTALL.md - boot - cabal.project-reinstall - compiler/CodeGen.Platform.h - compiler/GHC.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/614e35acd06214b318bcac5797ca6e2bd0d3dc96...a70b1692126efe41cf87d282f4968ee6e32561dd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/614e35acd06214b318bcac5797ca6e2bd0d3dc96...a70b1692126efe41cf87d282f4968ee6e32561dd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 1 22:43:38 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 01 Feb 2023 17:43:38 -0500 Subject: [Git][ghc/ghc][master] Remove tracing OPTIONS_GHC Message-ID: <63daeb1a92aa_2a4f3b9c710c15068fd@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 1 changed file: - compiler/GHC.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -3,7 +3,6 @@ {-# LANGUAGE TupleSections, NamedFieldPuns #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TypeFamilies #-} -{-# OPTIONS_GHC -ddump-stg-final -ddump-to-file #-} -- ----------------------------------------------------------------------------- -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/083e26ed6364e444b41e6693410cb549b188da38 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/083e26ed6364e444b41e6693410cb549b188da38 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 1 22:44:28 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 01 Feb 2023 17:44:28 -0500 Subject: [Git][ghc/ghc][master] doc: fix gcdetails_block_fragmentation_bytes since annotation Message-ID: <63daeb4c3fed8_2a4f599cf84815103df@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 1 changed file: - libraries/base/GHC/Stats.hsc Changes: ===================================== libraries/base/GHC/Stats.hsc ===================================== @@ -162,7 +162,8 @@ data GCDetails = GCDetails { -- | The amount of memory lost due to block fragmentation in bytes. -- Block fragmentation is the difference between the amount of blocks retained by the RTS and the blocks that are in use. -- This occurs when megablocks are only sparsely used, eg, when data that cannot be moved retains a megablock. - -- @since 4.17.0.0 + -- + -- @since 4.18.0.0 , gcdetails_block_fragmentation_bytes :: Word64 -- | The time elapsed during synchronisation before GC , gcdetails_sync_elapsed_ns :: RtsTime View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/354aa47d313113855aff9e5c5476fcb56f80e3bf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/354aa47d313113855aff9e5c5476fcb56f80e3bf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 1 23:11:35 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 01 Feb 2023 18:11:35 -0500 Subject: [Git][ghc/ghc][wip/T22761] 27 commits: Fixes for cabal-reinstall CI job Message-ID: <63daf1a717391_2a4f463a68441510737@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22761 at Glasgow Haskell Compiler / GHC Commits: 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 92e63178 by Simon Peyton Jones at 2023-02-01T20:14:17+00:00 Refactor the simplifier a bit to fix #22761 Commit message needs work... * ru_rhs is always occ-anal'd * More case with addRuleBndrs for strict bindings * sc_from field in StrictBind - - - - - 95771514 by Simon Peyton Jones at 2023-02-01T23:12:06+00:00 Wibble - - - - - 30 changed files: - .gitlab-ci.yml - cabal.project-reinstall - compiler/CodeGen.Platform.h - compiler/GHC/Builtin/Names.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Reg.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d2a8cc676fcc08046e11afea2734e1a4477d75a7...957715142d8b600894b9d1f4c7a1a042f790165e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d2a8cc676fcc08046e11afea2734e1a4477d75a7...957715142d8b600894b9d1f4c7a1a042f790165e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 00:03:44 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 01 Feb 2023 19:03:44 -0500 Subject: [Git][ghc/ghc][wip/T22404] Wibbles Message-ID: <63dafde08904_2a4f599cf8481518489@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: e1b5fea7 by Simon Peyton Jones at 2023-02-02T00:04:19+00:00 Wibbles - - - - - 1 changed file: - compiler/GHC/Core/Opt/OccurAnal.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -3461,8 +3461,9 @@ tagNonRecBinder lvl usage binder where occ = lookupDetails usage binder will_be_join = decideJoinPointHood lvl usage (NE.singleton binder) - occ' | will_be_join = -- must already be marked AlwaysTailCalled - assert (isAlwaysTailCalled occ) occ + occ' | will_be_join = -- Must already be marked AlwaysTailCalled, unless + -- it was a join point before but is now dead + assert (isAlwaysTailCalled occ || isDeadOcc occ) occ | otherwise = markNonTail occ tagRecBinders :: TopLevelFlag -- At top level? @@ -3546,14 +3547,21 @@ decideJoinPointHood :: TopLevelFlag -> UsageDetails -> Bool decideJoinPointHood TopLevel _ _ = False + decideJoinPointHood NotTopLevel usage bndrs - | isJoinId (NE.head bndrs) - = warnPprTrace (not all_ok) - "OccurAnal failed to rediscover join point(s)" (ppr bndrs) - all_ok + | isJoinId bndr1 +-- = warnPprTrace lost_join_point +-- "OccurAnal failed to rediscover join point(s)" (ppr bndrs) +-- all_ok + = assertPpr (not lost_join_point) (ppr bndrs) + True + | otherwise = all_ok where + bndr1 = NE.head bndrs + lost_join_point = not (isDeadOcc (lookupDetails usage bndr1)) && not all_ok + -- See Note [Invariants on join points]; invariants cited by number below. -- Invariant 2 is always satisfiable by the simplifier by eta expansion. all_ok = -- Invariant 3: Either all are join points or none are View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e1b5fea7b573441198e4cf8193ac8963fa1dadae -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e1b5fea7b573441198e4cf8193ac8963fa1dadae You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 00:15:32 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 01 Feb 2023 19:15:32 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Remove tracing OPTIONS_GHC Message-ID: <63db00a488f94_2a4f55fc815208b2@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - c421e07c by Jaro Reinders at 2023-02-01T19:15:04-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - f79854f0 by doyougnu at 2023-02-01T19:15:21-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 30 changed files: - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Types/Var/Env.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/rewrite_rules.rst - libraries/base/GHC/Stats.hsc - libraries/base/tests/Concurrent/all.T - libraries/base/tests/IO/T12010/test.T - libraries/base/tests/all.T - libraries/hpc - libraries/stm - testsuite/tests/ado/all.T - testsuite/tests/cabal/t22333/all.T - testsuite/tests/driver/T14075/all.T - testsuite/tests/driver/all.T - testsuite/tests/driver/fat-iface/T22405/all.T - testsuite/tests/driver/j-space/all.T - testsuite/tests/driver/t22391/all.T - testsuite/tests/lib/integer/all.T - testsuite/tests/numeric/should_run/all.T - testsuite/tests/perf/compiler/all.T - testsuite/tests/rename/should_compile/all.T - testsuite/tests/rename/should_fail/all.T - testsuite/tests/rep-poly/all.T - testsuite/tests/rts/all.T - + testsuite/tests/simplCore/should_compile/RewriteHigherOrderPatterns.hs - + testsuite/tests/simplCore/should_compile/RewriteHigherOrderPatterns.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/586646a4d0e86cbf6b563fc6ab58d08f54ea3052...f79854f09adaafaab8c974547048a35f716acdbd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/586646a4d0e86cbf6b563fc6ab58d08f54ea3052...f79854f09adaafaab8c974547048a35f716acdbd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 01:13:44 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 01 Feb 2023 20:13:44 -0500 Subject: [Git][ghc/ghc][wip/bump-win32-tarballs] 82 commits: Factorize hptModulesBelow Message-ID: <63db0e48ba14f_2a4fa049e4415284aa@gitlab.mail> Ben Gamari pushed to branch wip/bump-win32-tarballs at Glasgow Haskell Compiler / GHC Commits: 1bd32a35 by Sylvain Henry at 2023-01-26T12:34:21-05:00 Factorize hptModulesBelow Create and use moduleGraphModulesBelow in GHC.Unit.Module.Graph that doesn't need anything from the driver to be used. - - - - - 1262d3f8 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Store dehydrated data structures in CgModBreaks This fixes a tricky leak in GHCi where we were retaining old copies of HscEnvs when reloading. If not all modules were recompiled then these hydrated fields in break points would retain a reference to the old HscEnv which could double memory usage. Fixes #22530 - - - - - e27eb80c by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force more in NFData Name instance Doesn't force the lazy `OccName` field (#19619) which is already known as a really bad source of leaks. When we slam the hammer storing Names on disk (in interface files or the like), all this should be forced as otherwise a `Name` can easily retain an `Id` and hence the entire world. Fixes #22833 - - - - - 3d004d5a by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force OccName in tidyTopName This occname has just been derived from an `Id`, so need to force it promptly so we can release the Id back to the world. Another symptom of the bug caused by #19619 - - - - - f2a0fea0 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Strict fields in ModNodeKey (otherwise retains HomeModInfo) Towards #22530 - - - - - 5640cb1d by Sylvain Henry at 2023-01-26T12:35:36-05:00 Hadrian: fix doc generation Was missing dependencies on files generated by templates (e.g. ghc.cabal) - - - - - 3e827c3f by Richard Eisenberg at 2023-01-26T20:06:53-05:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. - - - - - b3ef5c89 by doyougnu at 2023-01-26T20:07:48-05:00 tryFillBuffer: strictify more speculative bangs - - - - - d0d7ba0f by Vladislav Zavialov at 2023-01-26T20:08:25-05:00 base: NoImplicitPrelude in Data.Void and Data.Kind This change removes an unnecessary dependency on Prelude from two modules in the base package. - - - - - fa1db923 by Matthew Pickering at 2023-01-26T20:09:00-05: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 - - - - - 807310a1 by Matthew Pickering at 2023-01-26T20:09:00-05:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. - - - - - c7116b10 by Ben Gamari at 2023-01-26T20:09:35-05:00 base: Make changelog proposal references more consistent Addresses #22773. - - - - - 6932cfc7 by Sylvain Henry at 2023-01-26T20:10:27-05:00 Fix spurious change from !9568 - - - - - e480fbc2 by Ben Gamari at 2023-01-27T05:01:24-05:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 - - - - - 2648c09c by Andrei Borzenkov at 2023-01-27T05:02:07-05:00 Replace errors from badOrigBinding with new one (#22839) Problem: in 02279a9c the type-level [] syntax was changed from a built-in name to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if a name is not built-in then it must have come from TH quotation, but this is not necessarily the case with []. The outdated assumption in badOrigBinding leads to incorrect error messages. This code: data [] Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []" Unfortunately, there is not enough information in RdrName to directly determine if the name was constructed via TH or by the parser, so this patch changes the error message instead. It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote into a new error TcRnBindingOfExistingName and changes its wording to avoid guessing the origin of the name. - - - - - 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - d702e98c by Ryan Scott at 2023-02-01T20:13:19-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - bca6f1a0 by Tamar Christina at 2023-02-01T20:13:24-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - de1d5250 by Ben Gamari at 2023-02-01T20:13:24-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - cabal.project-reinstall - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Reg.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/BlockLayout.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9f5971c30e33e0518dae155302309da1509564ea...de1d5250f8af033f96315fc61bf6d69ade871c01 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9f5971c30e33e0518dae155302309da1509564ea...de1d5250f8af033f96315fc61bf6d69ade871c01 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 05:15:50 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 02 Feb 2023 00:15:50 -0500 Subject: [Git][ghc/ghc][master] compiler: Implement higher order patterns in the rule matcher Message-ID: <63db47061a8ad_2a4f55f5015368bb@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 7 changed files: - compiler/GHC/Core/Rules.hs - compiler/GHC/Types/Var/Env.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/rewrite_rules.rst - + testsuite/tests/simplCore/should_compile/RewriteHigherOrderPatterns.hs - + testsuite/tests/simplCore/should_compile/RewriteHigherOrderPatterns.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -62,6 +62,7 @@ import GHC.Core.Coercion as Coercion import GHC.Core.Tidy ( tidyRules ) import GHC.Core.Map.Expr ( eqCoreExpr ) import GHC.Core.Opt.Arity( etaExpandToJoinPointRule ) +import GHC.Core.Make ( mkCoreLams ) import GHC.Tc.Utils.TcType ( tcSplitTyConApp_maybe ) import GHC.Builtin.Types ( anyTypeOfKind ) @@ -82,6 +83,7 @@ import GHC.Types.Basic import GHC.Data.FastString import GHC.Data.Maybe import GHC.Data.Bag +import GHC.Data.List.SetOps( hasNoDups ) import GHC.Utils.Misc as Utils import GHC.Utils.Outputable @@ -881,8 +883,13 @@ rvInScopeEnv renv = ISE (rnInScopeSet (rv_lcl renv)) (rv_unf renv) -- * The BindWrapper in a RuleSubst are the bindings floated out -- from nested matches; see the Let case of match, below -- -data RuleSubst = RS { rs_tv_subst :: TvSubstEnv -- Range is the - , rs_id_subst :: IdSubstEnv -- template variables +data RuleSubst = RS { -- Substitution; applied only to the template, not the target + -- Domain is the template variables + -- Range never includes template variables + rs_tv_subst :: TvSubstEnv + , rs_id_subst :: IdSubstEnv + + -- Floated bindings , rs_binds :: BindWrapper -- Floated bindings , rs_bndrs :: [Var] -- Variables bound by floated lets } @@ -1059,6 +1066,165 @@ match renv subst e1 (Var v2) mco -- Note [Expanding variables] -- because of the not-inRnEnvR ------------------------ Applications --------------------- +-- See Note [Matching higher order patterns] +match renv@(RV { rv_tmpls = tmpls, rv_lcl = rn_env }) + subst e1 at App{} e2 + MRefl -- Like the App case we insist on Refl here + -- See Note [Casts in the target] + | (Var f, args) <- collectArgs e1 + , let f' = rnOccL rn_env f -- See similar rnOccL in match_var + , f' `elemVarSet` tmpls -- (HOP1) + , Just vs2 <- traverse arg_as_lcl_var args -- (HOP2), (HOP3) + , hasNoDups vs2 -- (HOP4) + , not can_decompose_app_instead + = match_tmpl_var renv subst f' (mkCoreLams vs2 e2) + -- match_tmpl_var checks (HOP5) and (HOP6) + where + arg_as_lcl_var :: CoreExpr -> Maybe Var + arg_as_lcl_var (Var v) + | Just v' <- rnOccL_maybe rn_env v + , not (v' `elemVarSet` tmpls) -- rnEnvL contains the template variables + = Just (to_target v') -- to_target: see (W1) + -- in Note [Matching higher order patterns] + arg_as_lcl_var _ = Nothing + + can_decompose_app_instead -- Template (e1 v), target (e2 v), and v # fvs(e2) + = case (e1, e2) of -- See (W2) in Note [Matching higher order patterns] + (App _ (Var v1), App f2 (Var v2)) + -> rnOccL rn_env v1 == rnOccR rn_env v2 + && not (v2 `elemVarSet` exprFreeVars f2) + _ -> False + + ---------------- + -- to_target: see (W1) in Note [Matching higher order patterns] + to_target :: Var -> Var -- From canonical variable back to target-expr variable + to_target v = lookupVarEnv rev_envR v `orElse` v + + rev_envR :: VarEnv Var -- Inverts rnEnvR: from canonical variable + -- back to target-expr variable + rev_envR = nonDetStrictFoldVarEnv_Directly add_one emptyVarEnv (rnEnvR rn_env) + add_one uniq var env = extendVarEnv env var (var `setVarUnique` uniq) + +{- Note [Matching higher order patterns] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Higher order patterns provide a limited form of higher order matching. +See GHC Proposal #555 + https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0555-template-patterns.rst +and #22465 for more details and related work. + +Consider the potential match: + + Template: forall f. foo (\x -> f x) + Target: foo (\x -> x*2 + x) + +The expression `x*2 + x` in the target is not literally an application of a +function to the variable `x`, so the simple application rule does not apply. +However, we can match them modulo beta equivalence with the substitution: + + [f :-> \x -> x*2 + x] + +The general problem of higher order matching is tricky to implement, but +the subproblem which we call /higher order pattern matching/ is sufficient +for the given example and much easier to implement. + +Design: + +We start with terminology. + +* /Template variables/. The forall'd variables are called the template + variables. In the example match above, `f` is a template variable. + +* /Local binders/. The local binders of a rule are the variables bound + inside the template. In the example match above, `x` is a local binder. + Note that local binders can be term variables and type variables. + +A /higher order pattern/ (HOP) is a sub-expression of the template, +of form (f x y z) where: + +* (HOP1) f is a template variable +* (HOP2) x, y, z are local binders (like y in rule "wombat" above; see definitions). +* (HOP3) The arguments x, y, z are term variables +* (HOP4) The arguments x, y, z are distinct (no duplicates) + +Matching of higher order patterns (HOP-matching). A higher order pattern (f x y z) +(in the template) matches any target expression e provided: + +* (HOP5) The target has the same type as the template +* (HOP6) No local binder is free in e, other than x, y, z. + +If these two condition hold, the higher order pattern (f x y z) matches +the target expression e, yielding the substitution [f :-> \x y z. e]. +Notice that this substitution is type preserving, and the RHS +of the substitution has no free local binders. + +HOP matching is small enough to be done in-line in the `match` function. +Two wrinkles: + +(W1) Consider the potential match: + Template: forall f. foo (\x -> f x) + Target: foo (\y -> (y, y)) + During matching we make `x` the canonical variable for the lambdas + and then we see: + Template: f x rnEnvL = [] + Target: (y, y) rnEnvR = [y :-> x] + We could bind [f :-> \x. (x,x)], by applying rnEnvR substitution to the target + expression. But that is tiresome (a) because it involves a traversal, and + (b) because rnEnvR is a VarEnv Var, and we don't have a substitution function + for that. + + So instead, we invert rnEnvR, and apply it to the binders, to get + [f :-> \y. (y,y)]. This is done by `to_target` in the HOP-matching case. + It takes a little bit of thinking to be sure this will work right in the case + of shadowing. E.g. Template (\x y. f x y) Target (\p p. p*p) + Here rnEnvR will be just [p :-> y], so after inversion we'll get + [f :-> \x p. p*p] + but that is fine. + +(W2) This wrinkle concerns the overlp between the new HOP rule and the existing + decompose-application rule. See 3.1 of GHC Proposal #555 for a discussion. + + Consider potential match: + Template: forall f. foo (\x y. Just (f y x)) + Target: foo (\p q. Just (h (1+q) p))) + During matching we will encounter: + Template: f x y + Target: h (1+q) p rnEnvR = [p:->x, q:->y] + The rnEnvR renaming `[p:->x, q:->y]` is done by the matcher (today) on the fly, + to make the bound variables of the template and target "line up". + But now we can: + * Either use the new HOP rule to succeed with + [f :-> \x y. h (1+x) y] + * Or use the existing decompose-application rule to match + (f x) against (h (1+q)) and `y` against `p`. + This will succeed with + [f :-> \y. h (1+y)] + + Note that the result of the HOP rule will always be eta-equivalent to + the result of the decompose-application rule. But the proposal specifies + that we should use the decompose-application rule because it involves + less eta-expansion. + + But take care: + Template: forall f. foo (\x y. Just (f y x)) + Target: foo (\p q. Just (h (p+q) p))) + Then during matching we will encounter: + Template: f x y + Target: h (p+q) p rnEnvR = [p:->x, q:->y] + Now, we cannot use the decompose-application rule, because p is free in + (h (p+q)). So, we can only use the new HOP rule. + +(W3) You might wonder if a HOP can have /type/ arguments, thus (in Core) + RULE forall h. + f (\(MkT @b (d::Num b) (x::b)) -> h @b d x) = ... + where the HOP is (h @b d x). In principle this might be possible, but + it seems fragile; e.g. we would still need to insist that the (invisible) + @b was a type variable. And since `h` gets a polymoprhic type, that + type would have to be declared by the programmer. + + Maybe one day. But for now, we insist (in `arg_as_lcl_var`)that a HOP + has only term-variable arguments. +-} + -- Note the match on MRefl! We fail if there is a cast in the target -- (e1 e2) ~ (d1 d2) |> co -- See Note [Cancel reflexive casts]: in the Cast equations for 'match' @@ -1358,7 +1524,7 @@ match_tmpl_var renv@(RV { rv_lcl = rn_env, rv_fltR = flt_env }) -- if the right side of the env is empty. | anyInRnEnvR rn_env (exprFreeVars e2) = Nothing -- Skolem-escape failure - -- e.g. match forall a. (\x-> a x) against (\y. y y) + -- e.g. match forall a. (\x -> a) against (\y -> y) | Just e1' <- lookupVarEnv id_subst v1' = if eqCoreExpr e1' e2' @@ -1378,6 +1544,7 @@ match_tmpl_var renv@(RV { rv_lcl = rn_env, rv_fltR = flt_env }) -- because no free var of e2' is in the rnEnvR of the envt ------------------------------------------ + match_ty :: RuleMatchEnv -> RuleSubst -> Type -- Template @@ -1389,12 +1556,13 @@ match_ty :: RuleMatchEnv -- newtype T = MkT Int -- We only want to replace (f T) with f', not (f Int). -match_ty renv subst ty1 ty2 - = do { tv_subst' - <- Unify.ruleMatchTyKiX (rv_tmpls renv) (rv_lcl renv) tv_subst ty1 ty2 +match_ty (RV { rv_tmpls = tmpls, rv_lcl = rn_env }) + subst@(RS { rs_tv_subst = tv_subst }) + ty1 ty2 + = do { tv_subst' <- Unify.ruleMatchTyKiX tmpls rn_env tv_subst ty1 ty2 + -- NB: ruleMatchTyKiX applis tv_subst to ty1 only + -- and of course only binds 'tmpls' ; return (subst { rs_tv_subst = tv_subst' }) } - where - tv_subst = rs_tv_subst subst {- Note [Matching variable types] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Types/Var/Env.hs ===================================== @@ -24,6 +24,7 @@ module GHC.Types.Var.Env ( elemVarEnvByKey, filterVarEnv, restrictVarEnv, partitionVarEnv, varEnvDomain, + nonDetStrictFoldVarEnv_Directly, -- * Deterministic Var environments (maps) DVarEnv, DIdEnv, DTyVarEnv, @@ -318,25 +319,30 @@ rnBndr2 env bL bR = fst $ rnBndr2_var env bL bR rnBndr2_var :: RnEnv2 -> Var -> Var -> (RnEnv2, Var) -- ^ Similar to 'rnBndr2' but returns the new variable as well as the --- new environment +-- new environment. +-- Postcondition: the type of the returned Var is that of bR rnBndr2_var (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL bR - = (RV2 { envL = extendVarEnv envL bL new_b -- See Note - , envR = extendVarEnv envR bR new_b -- [Rebinding] + = (RV2 { envL = extendVarEnv envL bL new_b -- See Note + , envR = extendVarEnv envR bR new_b -- [Rebinding] , in_scope = extendInScopeSet in_scope new_b }, new_b) where -- Find a new binder not in scope in either term - new_b | not (bL `elemInScopeSet` in_scope) = bL - | not (bR `elemInScopeSet` in_scope) = bR - | otherwise = uniqAway' in_scope bL + -- To avoid calling `uniqAway`, we try bL's Unique + -- But we always return a Var whose type is that of bR + new_b | not (bR `elemInScopeSet` in_scope) = bR + | not (bL `elemInScopeSet` in_scope) = bR `setVarUnique` varUnique bL + | otherwise = uniqAway' in_scope bR -- Note [Rebinding] -- ~~~~~~~~~~~~~~~~ -- If the new var is the same as the old one, note that - -- the extendVarEnv *deletes* any current renaming + -- the extendVarEnv *replaces* any current renaming -- E.g. (\x. \x. ...) ~ (\y. \z. ...) -- + -- envL envR in_scope -- Inside \x \y { [x->y], [y->y], {y} } - -- \x \z { [x->x], [y->y, z->x], {y,x} } + -- \x \z { [x->z], [y->y, z->z], {y,z} } + -- The envL binding [x->y] is replaced by [x->z] rnBndrL :: RnEnv2 -> Var -> (RnEnv2, Var) -- ^ Similar to 'rnBndr2' but used when there's a binder on the left @@ -530,6 +536,7 @@ lookupWithDefaultVarEnv :: VarEnv a -> a -> Var -> a elemVarEnv :: Var -> VarEnv a -> Bool elemVarEnvByKey :: Unique -> VarEnv a -> Bool disjointVarEnv :: VarEnv a -> VarEnv a -> Bool +nonDetStrictFoldVarEnv_Directly :: (Unique -> a -> r -> r) -> r -> VarEnv a -> r elemVarEnv = elemUFM elemVarEnvByKey = elemUFM_Directly @@ -565,6 +572,7 @@ unitVarEnv = unitUFM isEmptyVarEnv = isNullUFM partitionVarEnv = partitionUFM varEnvDomain = domUFMUnVarSet +nonDetStrictFoldVarEnv_Directly = nonDetStrictFoldUFM_Directly restrictVarEnv env vs = filterUFM_Directly keep env ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -11,7 +11,15 @@ Compiler - Added a new warning :ghc-flag:`-Wterm-variable-capture` that helps to make code compatible with the future extension ``RequiredTypeArguments``. -======= + +- Rewrite rules now support a limited form of higher order matching when a + pattern variable is applied to distinct locally bound variables. For example: :: + + forall f. foo (\x -> f x) + + Now matches: :: + + foo (\x -> x*2 + x) GHCi ~~~~ ===================================== docs/users_guide/exts/rewrite_rules.rst ===================================== @@ -228,6 +228,32 @@ From a semantic point of view: because ``y`` can match against ``0``. +- GHC implements **higher order matching** as described by + `GHC proposal #555 `_. + When a pattern variable is applied to distinct locally bound variables it forms + what we call a **higher order pattern**. + When matching, higher order patterns are treated like pattern variables, but they are + allowed to match expressions that contain the locally bound variables that are part of + the higher order patterns. + + For example, we can use this to fix the broken rule from the example from the + previous bullet point:: + + {-# RULES + "test/case-tup" forall (x :: (Int, Int)) (f :: Int -> Int -> Int) (z :: Int). + test (case x of (l, r) -> f l r) z = case x of (m, n) -> test (f m n) z + #-} + + This modified rule does fire for:: + + prog :: (Int, Int) -> (Int, Int) + prog x = test (case x of (p, q) -> p) 0 + + Under higher order matching, ``f p q`` matches ``p`` by assigning ``f = \p q -> p``. + The resulting code after the rewrite is:: + + prog x = case x of (m, n) -> test ((\p q -> p) m n) 0 + - A rule that has a forall binder with a polymorphic type, is likely to fail to fire. E. g., :: {-# RULES forall (x :: forall a. Num a => a -> a). f x = blah #-} ===================================== testsuite/tests/simplCore/should_compile/RewriteHigherOrderPatterns.hs ===================================== @@ -0,0 +1,46 @@ +-- These are the examples from the Higher Order Patterns in Rewrite Rules proposal + +module RewriteHigherOrderPatterns where + +foo :: (Int -> Int) -> Bool +{-# NOINLINE foo #-} +foo _ = False + +{-# RULES "foo" forall f. foo (\x -> f x) = True #-} + +bar :: (Int -> Int -> Int -> Int) -> Bool +{-# NOINLINE bar #-} +bar _ = False + +{-# RULES "bar" forall f. bar (\x y z -> f x y z) = True #-} + +baz :: (Int -> Int) -> Bool +{-# NOINLINE baz #-} +baz _ = False + +{-# RULES "baz" forall f. baz (\x -> f x x) = True #-} + +qux :: (Int -> Int -> Int) -> Bool +{-# NOINLINE qux #-} +qux _ = False + +{-# RULES "qux" forall f. qux (\x y -> f x (2 :: Int) y) = True #-} + +-- instead of + and * we use 'two' and 'three' to avoid cluttering +-- the rule rewrites dump. + +two :: Int -> Int -> Int +{-# NOINLINE two #-} +two _ _ = 2 + +three :: Int -> Int -> Int -> Int +{-# NOINLINE three #-} +three _ _ _ = 3 + +ex1 = foo (\x -> two (two x 2) x) +ex2 = bar (\x y z -> two (two x y) z) +ex3 = bar (\x y z -> two (two x 2) z) +ex4 = baz (\x -> two x (two x 2)) +ex5 = baz (\x -> three (two x 1) 2 x) +ex6 = qux (\x y -> two (two x 2) y) +ex7 = qux (\x y -> three (two x 1) 2 y) ===================================== testsuite/tests/simplCore/should_compile/RewriteHigherOrderPatterns.stderr ===================================== @@ -0,0 +1,30 @@ +Rule fired + Rule: bar + Module: (RewriteHigherOrderPatterns) + Before: bar ValArg \ x y z -> two (two x y) z + After: (\ f -> True) (\ x y -> two (two x y)) + Cont: Stop[RhsCtxt(NonRecursive)] Bool +Rule fired + Rule: bar + Module: (RewriteHigherOrderPatterns) + Before: bar ValArg \ x _ z -> two (two x (I# 2#)) z + After: (\ f -> True) (\ x _ -> two (two x (I# 2#))) + Cont: Stop[RhsCtxt(NonRecursive)] Bool +Rule fired + Rule: foo + Module: (RewriteHigherOrderPatterns) + Before: foo ValArg \ x -> two (two x (I# 2#)) x + After: (\ f -> True) (\ x -> two (two x (I# 2#)) x) + Cont: Stop[RhsCtxt(NonRecursive)] Bool +Rule fired + Rule: qux + Module: (RewriteHigherOrderPatterns) + Before: qux ValArg \ x y -> three (two x (I# 1#)) (I# 2#) y + After: (\ f -> True) (\ x -> three (two x (I# 1#))) + Cont: Stop[RhsCtxt(NonRecursive)] Bool +Rule fired + Rule: baz + Module: (RewriteHigherOrderPatterns) + Before: baz ValArg \ x -> three (two x (I# 1#)) (I# 2#) x + After: (\ f -> True) (\ x -> three (two x (I# 1#)) (I# 2#)) + Cont: Stop[RhsCtxt(NonRecursive)] Bool ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -473,3 +473,4 @@ test('T22715_2', normal, multimod_compile, ['T22715_2', '-v0 -O -fspecialise-agg test('T22802', normal, compile, ['-O']) test('T15205', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) +test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/61ce5bf6b930f2f91471f36a26bcaddea279b515 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/61ce5bf6b930f2f91471f36a26bcaddea279b515 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 05:16:33 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 02 Feb 2023 00:16:33 -0500 Subject: [Git][ghc/ghc][master] CI: JavaScript backend runs testsuite Message-ID: <63db4731b503c_2a4fa049e441540664@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 30 changed files: - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - libraries/base/tests/Concurrent/all.T - libraries/base/tests/IO/T12010/test.T - libraries/base/tests/all.T - libraries/hpc - libraries/stm - testsuite/tests/ado/all.T - testsuite/tests/cabal/t22333/all.T - testsuite/tests/driver/T14075/all.T - testsuite/tests/driver/all.T - testsuite/tests/driver/fat-iface/T22405/all.T - testsuite/tests/driver/j-space/all.T - testsuite/tests/driver/t22391/all.T - testsuite/tests/lib/integer/all.T - testsuite/tests/numeric/should_run/all.T - testsuite/tests/perf/compiler/all.T - testsuite/tests/rename/should_compile/all.T - testsuite/tests/rename/should_fail/all.T - testsuite/tests/rep-poly/all.T - testsuite/tests/rts/all.T - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/stranal/should_run/all.T - testsuite/tests/type-data/should_compile/all.T - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_run/all.T - testsuite/tests/unboxedsums/all.T - testsuite/tests/unboxedsums/module/all.T Changes: ===================================== .gitlab/ci.sh ===================================== @@ -601,6 +601,16 @@ function test_hadrian() { if [[ "${CROSS_EMULATOR:-}" == "NOT_SET" ]]; then info "Cannot test cross-compiled build without CROSS_EMULATOR being set." return + # special case for JS backend + elif [ -n "${CROSS_TARGET:-}" ] && [ "${CROSS_EMULATOR:-}" == "js-emulator" ]; then + # run "hadrian test" directly, not using the bindist, even though it did get installed. + # This is a temporary solution, See !9515 for the status of hadrian support. + run_hadrian \ + test \ + --summary-junit=./junit.xml \ + --test-have-intree-files \ + --docs=none \ + "runtest.opts+=${RUNTEST_ARGS:-}" || fail "cross-compiled hadrian main testsuite" elif [ -n "${CROSS_TARGET:-}" ]; then local instdir="$TOP/_build/install" local test_compiler="$instdir/bin/${cross_prefix}ghc$exe" ===================================== .gitlab/gen_ci.hs ===================================== @@ -882,7 +882,7 @@ job_groups = , standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken static) , 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 "js-unknown-ghcjs" NoEmulatorNeeded (Just "emconfigure") + , validateBuilds Amd64 (Linux Debian11) (crossConfig "js-unknown-ghcjs" (Emulator "js-emulator") (Just "emconfigure") ) { bignumBackend = Native } ===================================== .gitlab/jobs.yaml ===================================== @@ -1505,6 +1505,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp", "CONFIGURE_WRAPPER": "emconfigure", + "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "js-unknown-ghcjs", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_js-unknown-ghcjs-validate", "XZ_OPT": "-9" @@ -4048,6 +4049,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp", "CONFIGURE_WRAPPER": "emconfigure", + "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "js-unknown-ghcjs", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_js-unknown-ghcjs-validate" } ===================================== compiler/GHC.hs ===================================== @@ -357,7 +357,9 @@ import GHC.Utils.Monad import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic +#if !defined(js_HOST_ARCH) import GHC.Utils.Panic.Plain +#endif import GHC.Utils.Logger import GHC.Utils.Fingerprint @@ -558,13 +560,13 @@ withCleanupSession ghc = ghc `MC.finally` cleanup initGhcMonad :: GhcMonad m => Maybe FilePath -> m () initGhcMonad mb_top_dir = setSession =<< liftIO ( do +#if !defined(js_HOST_ARCH) -- The call to c_keepCAFsForGHCi must not be optimized away. Even in non-debug builds. -- So we can't use assertM here. -- See Note [keepCAFsForGHCi] in keepCAFsForGHCi.c for details about why. --- #if MIN_VERSION_GLASGOW_HASKELL(9,7,0,0) !keep_cafs <- c_keepCAFsForGHCi massert keep_cafs --- #endif +#endif initHscEnv mb_top_dir ) @@ -1959,7 +1961,8 @@ instance Exception GhcApiError mkApiErr :: DynFlags -> SDoc -> GhcApiError mkApiErr dflags msg = GhcApiError (showSDoc dflags msg) --- + +#if !defined(js_HOST_ARCH) foreign import ccall unsafe "keepCAFsForGHCi" c_keepCAFsForGHCi :: IO Bool - +#endif ===================================== libraries/base/tests/Concurrent/all.T ===================================== @@ -1,3 +1,3 @@ -test('Chan002', extra_run_opts('100'), compile_and_run, ['']) +test('Chan002', [extra_run_opts('100'), fragile(22836)], compile_and_run, ['']) test('Chan003', extra_run_opts('200'), compile_and_run, ['']) test('ThreadDelay001', js_broken(22374), compile_and_run, ['']) ===================================== libraries/base/tests/IO/T12010/test.T ===================================== @@ -3,5 +3,6 @@ test('T12010', only_ways(['threaded1']), extra_ways(['threaded1']), when(wordsize(32), fragile(16572)), + js_broken(22374), cmd_prefix('WAY_FLAGS="' + ' '.join(config.way_flags['threaded1']) + '"')], makefile_test, []) ===================================== libraries/base/tests/all.T ===================================== @@ -240,7 +240,10 @@ test('T11555', normal, compile_and_run, ['']) test('T12494', normal, compile_and_run, ['']) test('T12852', [when(opsys('mingw32'), skip), js_broken(22374)], compile_and_run, ['']) test('lazySTexamples', normal, compile_and_run, ['']) -test('T11760', [req_ghc_smp, req_target_smp], compile_and_run, ['-threaded -with-rtsopts=-N2']) +test('T11760', [req_ghc_smp, + req_target_smp, + only_ways(['threaded1', 'threaded2', 'nonmoving_thr'])], + compile_and_run, ['-threaded -with-rtsopts=-N2']) test('T12874', normal, compile_and_run, ['']) test('T13191', [ collect_stats('bytes allocated', 5) ===================================== libraries/hpc ===================================== @@ -1 +1 @@ -Subproject commit 622595962acc1b07eaba4574c21375927579d189 +Subproject commit 767f476a5aa19260c8297ce40134f56d6f890019 ===================================== libraries/stm ===================================== @@ -1 +1 @@ -Subproject commit 4ac6ead642829c9c983ee3c96ba13fa0308891ff +Subproject commit cfb7e775c5f6df281b7052b7b4e4a51dafda10d2 ===================================== testsuite/tests/ado/all.T ===================================== @@ -20,5 +20,5 @@ test('T15344', normal, compile_and_run, ['']) test('T16628', normal, compile_fail, ['']) test('T17835', normal, compile, ['']) test('T20540', normal, compile, ['']) -test('T16135', when(compiler_debugged(),expect_broken(16135)), compile, ['']) +test('T16135', [when(compiler_debugged(),expect_broken(16135)), js_broken(22576)], compile, ['']) test('T22483', normal, compile, ['-Wall']) ===================================== testsuite/tests/cabal/t22333/all.T ===================================== @@ -1,4 +1,4 @@ test('T22333', - [extra_files(['Setup.hs', 'my-exe', 'my-package-a', 'my-package-b' ])], + [extra_files(['Setup.hs', 'my-exe', 'my-package-a', 'my-package-b' ]), js_broken(22573)], makefile_test, []) ===================================== testsuite/tests/driver/T14075/all.T ===================================== @@ -1,6 +1,5 @@ test('T14075', [ extra_files(['F.hs', 'F.hs-boot', 'O.hs', 'V.hs', 'V.hs-boot']) , req_ghc_smp # uses ghc --make -j2 - , js_broken(22261) ], makefile_test, []) ===================================== testsuite/tests/driver/all.T ===================================== @@ -278,7 +278,7 @@ test('T13604a', ], makefile_test, []) # omitting hpc and profasm because they affect the # inlining and unfoldings -test('inline-check', omit_ways(['hpc', 'profasm']) +test('inline-check', [omit_ways(['hpc', 'profasm']), js_broken(22576)] , compile , ['-dinline-check foo -O -ddebug-output']) @@ -319,4 +319,4 @@ test('T21869', [js_broken(22261), when(unregisterised(), skip)], makefile_test, test('T22044', normal, makefile_test, []) test('T22048', [only_ways(['normal']), grep_errmsg("_rule")], compile, ["-O -fomit-interface-pragmas -ddump-simpl"]) test('T21722', normal, compile_fail, ['-fno-show-error-context']) -test('T22669', normal, makefile_test, []) +test('T22669', js_skip, makefile_test, []) ===================================== testsuite/tests/driver/fat-iface/T22405/all.T ===================================== @@ -1,2 +1,2 @@ -test('T22405', [extra_files(['Main.hs'])], makefile_test, ['T22405']) -test('T22405b', [extra_files(['Main2.hs'])], makefile_test, ['T22405b']) +test('T22405', [extra_files(['Main.hs']), js_broken(22576)], makefile_test, ['T22405']) +test('T22405b', [extra_files(['Main2.hs']), js_broken(22576)], makefile_test, ['T22405b']) ===================================== testsuite/tests/driver/j-space/all.T ===================================== @@ -1 +1 @@ -test('jspace', [extra_files(['genJspace']), req_target_smp, req_ghc_smp], makefile_test, ['jspace']) +test('jspace', [extra_files(['genJspace']), req_target_smp, req_ghc_smp, js_broken(22573)], makefile_test, ['jspace']) ===================================== testsuite/tests/driver/t22391/all.T ===================================== @@ -1,5 +1,5 @@ test('t22391', [extra_files(['src'])], multimod_compile, ['Lib', '-v1 -Wall -fhide-source-paths -isrc -fdefer-diagnostics']) -test('t22391j', [req_target_smp, req_ghc_smp, extra_files(['src'])], +test('t22391j', [req_ghc_smp, req_target_smp, extra_files(['src'])], multimod_compile, ['Lib', '-v1 -Wall -fhide-source-paths -isrc -fdefer-diagnostics -j2']) ===================================== testsuite/tests/lib/integer/all.T ===================================== @@ -5,9 +5,9 @@ test('plusMinusInteger', [omit_ways(['ghci'])], compile_and_run, ['']) test('integerConstantFolding', normal, makefile_test, ['integerConstantFolding']) test('naturalConstantFolding', normal, makefile_test, ['naturalConstantFolding']) -test('fromToInteger', normal, makefile_test, ['fromToInteger']) +test('fromToInteger', js_broken(22576), makefile_test, ['fromToInteger']) -test('IntegerConversionRules', [], makefile_test, ['IntegerConversionRules']) +test('IntegerConversionRules', [js_broken(22576)], makefile_test, ['IntegerConversionRules']) test('gcdInteger', normal, compile_and_run, ['']) test('gcdeInteger', normal, compile_and_run, ['']) test('integerPowMod', [], compile_and_run, ['']) ===================================== testsuite/tests/numeric/should_run/all.T ===================================== @@ -79,5 +79,5 @@ test('IntegerToFloat', normal, compile_and_run, ['']) test('T20291', normal, compile_and_run, ['']) test('T22282', normal, compile_and_run, ['']) -test('T22671', normal, compile_and_run, ['']) -test('foundation', normal, compile_and_run, ['-O -package transformers']) +test('T22671', js_broken(22835), compile_and_run, ['']) +test('foundation', js_broken(22576), compile_and_run, ['-O -package transformers']) ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -657,6 +657,6 @@ test('T21839c', ['-O']) test ('InfiniteListFusion', - [collect_stats('bytes allocated',2), when(arch('i386'), skip)], + [collect_stats('bytes allocated',2), when(arch('i386'), skip), js_broken(22576)], compile_and_run, ['-O2 -package ghc']) ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -198,4 +198,4 @@ test('T22513e', normal, compile, ['-Wterm-variable-capture']) test('T22513f', normal, compile, ['-Wterm-variable-capture']) test('T22513g', normal, compile, ['-Wterm-variable-capture']) test('T22513h', normal, compile, ['-Wterm-variable-capture']) -test('T22513i', normal, compile, ['-Wterm-variable-capture']) \ No newline at end of file +test('T22513i', req_th, compile, ['-Wterm-variable-capture']) ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -184,7 +184,7 @@ test('T21605b', normal, compile_fail, ['']) test('T21605c', normal, compile_fail, ['']) test('T21605d', normal, compile_fail, ['']) test('T22839', normal, compile_fail, ['']) -test('RnPatternSynonymFail', normal, compile_fail, ['']) +test('RnPatternSynonymFail', js_broken(22261), compile_fail, ['']) test('RnMultipleFixityFail', normal, compile_fail, ['']) test('RnEmptyCaseFail', normal, compile_fail, ['']) test('RnDefaultSigFail', normal, compile_fail, ['']) ===================================== testsuite/tests/rep-poly/all.T ===================================== @@ -85,7 +85,7 @@ test('RepPolyUnliftedNewtype', normal, compile, ['-fno-warn-partial-type-signatures -fno-warn-deprecated-flags']) test('RepPolyWildcardPattern', normal, compile_fail, ['']) test('RepPolyWrappedVar', normal, compile_fail, ['']) -test('RepPolyWrappedVar2', normal, compile, ['']) +test('RepPolyWrappedVar2', js_broken(22576), compile, ['']) test('UnliftedNewtypesCoerceFail', normal, compile_fail, ['']) test('UnliftedNewtypesLevityBinder', normal, compile_fail, ['']) ===================================== testsuite/tests/rts/all.T ===================================== @@ -404,7 +404,7 @@ test('T11788', [ when(ghc_dynamic(), skip) , req_interp ], makefile_test, ['T11788']) -test('T10296a', [req_ghc_smp], makefile_test, ['T10296a']) +test('T10296a', [req_ghc_smp, req_c], makefile_test, ['T10296a']) test('T10296b', [only_ways(['threaded2'])], compile_and_run, ['']) @@ -429,7 +429,9 @@ test('T12903', [ when(opsys('mingw32'), skip) , compile_and_run, ['']) test('T13832', exit_code(1), compile_and_run, ['-threaded']) -test('T13894', normal, compile_and_run, ['']) +# js_skip T13894 because the JS backend only allocates pinned arrays so this +# test will always fail +test('T13894', js_skip, compile_and_run, ['']) # this test fails with the profasm way on some machines but not others, # so we just skip it. test('T14497', [omit_ways(['profasm']), multi_cpu_race], compile_and_run, ['-O']) ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -378,7 +378,7 @@ test('T20200a', normal, compile, ['-O2']) test('T20200b', normal, compile, ['-O2']) test('T20200KG', [extra_files(['T20200KGa.hs', 'T20200KG.hs-boot'])], multimod_compile, ['T20200KG', '-v0 -O2 -fspecialise-aggressively']) test('T20639', normal, compile, ['-O2']) -test('T20894', normal, compile, ['-dcore-lint -O1 -ddebug-output']) +test('T20894', js_broken(22576), compile, ['-dcore-lint -O1 -ddebug-output']) test('T19790', normal, compile, ['-O -ddump-rule-firings']) # This one had a Lint failure due to an occurrence analysis bug ===================================== testsuite/tests/stranal/should_run/all.T ===================================== @@ -1,6 +1,6 @@ # Run this always as we compile the test with -O0 and -O1 and check that the # output is correct and the same in both cases. -test('T16197', normal, makefile_test, []) +test('T16197', js_broken(22576), makefile_test, []) # Run the rest only in optasm way (which implies -O), we're testing the # strictness analyser here ===================================== testsuite/tests/type-data/should_compile/all.T ===================================== @@ -3,5 +3,5 @@ test('TDExistential', normal, compile, ['']) test('TDGADT', normal, compile, ['']) test('TDGoodConsConstraints', normal, compile, ['']) test('TDVector', normal, compile, ['']) -test('TD_TH_splice', normal, compile, ['']) +test('TD_TH_splice', js_broken(22576), compile, ['']) test('T22315a', [extra_files(['T22315a/'])], multimod_compile, ['T22315a.Lib T22315a.Main', '-v0']) ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -328,7 +328,7 @@ test('T8262', normal, compile_fail, ['']) # TcCoercibleFail times out with the compiler is compiled with -DDEBUG. # This is expected (see comment in source file). -test('TcCoercibleFail', [when(compiler_debugged(), skip)], compile_fail, ['']) +test('TcCoercibleFail', [when(compiler_debugged(), skip), js_broken(22576)], compile_fail, ['']) test('TcCoercibleFail2', [], compile_fail, ['']) test('TcCoercibleFail3', [], compile_fail, ['']) @@ -413,7 +413,6 @@ test('T11990b', normal, compile_fail, ['']) test('T12035', [], multimod_compile_fail, ['T12035', '-v0']) test('T12035j', [ extra_files(['T12035.hs', 'T12035a.hs', 'T12035.hs-boot']) , req_ghc_smp - , js_broken(22261) ], multimod_compile_fail, ['T12035', '-j2 -v0']) test('T12045b', normal, compile_fail, ['']) test('T12045c', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_run/all.T ===================================== @@ -125,7 +125,7 @@ test('KindInvariant', normal, ghci_script, ['KindInvariant.script']) # unboxed sums and ghci does not support those yet. test('StrictPats', omit_ways(['ghci']), compile_and_run, ['']) test('T12809', omit_ways(['ghci']), compile_and_run, ['']) -test('EtaExpandLevPoly', omit_ways(['ghci']), compile_and_run, ['']) +test('EtaExpandLevPoly', [omit_ways(['ghci']), js_broken(22576)], compile_and_run, ['']) test('TestTypeableBinary', normal, compile_and_run, ['']) test('Typeable1', normal, compile_fail, ['-Werror']) ===================================== testsuite/tests/unboxedsums/all.T ===================================== @@ -45,7 +45,7 @@ test('unpack_sums_2', normal, compile, ['-O']) test('unpack_sums_3', normal, compile_and_run, ['-O']) test('unpack_sums_4', normal, compile_and_run, ['-O']) test('unpack_sums_5', normal, compile, ['']) -test('unpack_sums_6', fragile(22504), compile_and_run, ['-O']) +test('unpack_sums_6', [fragile(22504), js_broken(22374)], compile_and_run, ['-O']) test('unpack_sums_7', normal, makefile_test, []) test('unpack_sums_8', normal, compile_and_run, [""]) test('unpack_sums_9', normal, compile, [""]) @@ -59,6 +59,7 @@ test('T22208', normal, compile, ['-dstg-lint -dcmm-lint']) test('ManyUbxSums', [ pre_cmd('{compiler} --run ./GenManyUbxSums.hs'), extra_files(['GenManyUbxSums.hs', 'ManyUbxSums_Addr.hs']), + js_broken(22576) ], multi_compile_and_run, ['ManyUbxSums', ===================================== testsuite/tests/unboxedsums/module/all.T ===================================== @@ -1,2 +1,2 @@ -test('sum_mod', [normalise_slashes, extra_files(['Lib.hs', 'Main.hs']), js_broken(22261)], +test('sum_mod', [normalise_slashes, extra_files(['Lib.hs', 'Main.hs'])], run_command, ['$MAKE -s main --no-print-director']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/394b91ce859653231813fb9af77c26664063c1b6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/394b91ce859653231813fb9af77c26664063c1b6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 06:30:21 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Thu, 02 Feb 2023 01:30:21 -0500 Subject: [Git][ghc/ghc][wip/js-fileStat] 135 commits: Bump ghc-tarballs to fix #22497 Message-ID: <63db587d3e52b_2a4f55f5015488db@gitlab.mail> Josh Meredith pushed to branch wip/js-fileStat at Glasgow Haskell Compiler / GHC Commits: f891a442 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. - - - - - b13c6ea5 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. - - - - - c45a5fff by Cheng Shao at 2023-01-18T07:28:37-05:00 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. - - - - - b4c14c4b by Luite Stegeman at 2023-01-18T14:21:42-05:00 Add PrimCallConv support to GHCi This adds support for calling Cmm code from bytecode using the native calling convention, allowing modules that use `foreign import prim` to be loaded and debugged in GHCi. This patch introduces a new `PRIMCALL` bytecode instruction and a helper stack frame `stg_primcall`. The code is based on the existing functionality for dealing with unboxed tuples in bytecode, which has been generalised to handle arbitrary calls. Fixes #22051 - - - - - d0a63ef8 by Adam Gundry at 2023-01-18T14:22:26-05:00 Refactor warning flag parsing to add missing flags This adds `-Werror=<group>` and `-fwarn-<group>` flags for warning groups as well as individual warnings. Previously these were defined on an ad hoc basis so for example we had `-Werror=compat` but not `-Werror=unused-binds`, whereas we had `-fwarn-unused-binds` but not `-fwarn-compat`. Fixes #22182. - - - - - 7ed1b8ef by Adam Gundry at 2023-01-18T14:22:26-05:00 Minor corrections to comments - - - - - 5389681e by Adam Gundry at 2023-01-18T14:22:26-05:00 Revise warnings documentation in user's guide - - - - - ab0d5cda by Adam Gundry at 2023-01-18T14:22:26-05:00 Move documentation of deferred type error flags out of warnings section - - - - - eb5a6b91 by John Ericson at 2023-01-18T22:24:10-05:00 Give the RTS it's own configure script Currently it doesn't do much anything, we are just trying to introduce it without breaking the build. Later, we will move functionality from the top-level configure script over to it. We need to bump Cabal for https://github.com/haskell/cabal/pull/8649; to facilitate and existing hack of skipping some configure checks for the RTS we now need to skip just *part* not *all* of the "post configure" hook, as running the configure script (which we definitely want to do) is also implemented as part of the "post configure" hook. But doing this requires exposing functionality that wasn't exposed before. - - - - - 32ab07bf by Bodigrim at 2023-01-18T22:24:51-05:00 ghc package does not have to depend on terminfo - - - - - 981ff7c4 by Bodigrim at 2023-01-18T22:24:51-05:00 ghc-pkg does not have to depend on terminfo - - - - - f058e367 by Ben Gamari at 2023-01-18T22:25:27-05:00 nativeGen/X86: MFENCE is unnecessary for release semantics In #22764 a user noticed that a program implementing a simple atomic counter via an STRef regressed significantly due to the introduction of necessary atomic operations in the MutVar# primops (#22468). This regression was caused by a bug in the NCG, which emitted an unnecessary MFENCE instruction for a release-ordered atomic write. MFENCE is rather only needed to achieve sequentially consistent ordering. Fixes #22764. - - - - - 154889db by Ryan Scott at 2023-01-18T22:26:03-05:00 Add regression test for #22151 Issue #22151 was coincidentally fixed in commit aed1974e92366ab8e117734f308505684f70cddf (`Refactor the treatment of loopy superclass dicts`). This adds a regression test to ensure that the issue remains fixed. Fixes #22151. - - - - - 14b5982a by Andrei Borzenkov at 2023-01-18T22:26:43-05:00 Fix printing of promoted MkSolo datacon (#22785) Problem: In 2463df2f, the Solo data constructor was renamed to MkSolo, and Solo was turned into a pattern synonym for backwards compatibility. Since pattern synonyms can not be promoted, the old code that pretty-printed promoted single-element tuples started producing ill-typed code: t :: Proxy ('Solo Int) This fails with "Pattern synonym ‘Solo’ used as a type" The solution is to track the distinction between type constructors and data constructors more carefully when printing single-element tuples. - - - - - 1fe806d3 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add hi_core flavour transformer The hi_core flavour transformer enables -fwrite-if-simplified-core for stage1 libraries, which emit core into interface files to make it possible to restart code generation. Building boot libs with it makes it easier to use GHC API to prototype experimental backends that needs core/stg at link time. - - - - - 317cad26 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add missing docs for recently added flavour transformers - - - - - 658f4446 by Ben Gamari at 2023-01-23T04:49:23-05:00 gitlab-ci: Add Rocky8 jobs Addresses #22268. - - - - - a83ec778 by Vladislav Zavialov at 2023-01-23T04:49:58-05:00 Set "since: 9.8" for TypeAbstractions and -Wterm-variable-capture These flags did not make it into the 9.6 release series, so the "since" annotations must be corrected. - - - - - fec7c2ea by Alan Zimmerman at 2023-01-23T04:50:33-05:00 EPA: Add SourceText to HsOverLabel To be able to capture string literals with possible escape codes as labels. Close #22771 - - - - - 3efd1e99 by Ben Gamari at 2023-01-23T04:51:08-05:00 template-haskell: Bump version to 2.20.0.0 Updates `text` and `exceptions` submodules for bounds bumps. Addresses #22767. - - - - - 0900b584 by Cheng Shao at 2023-01-23T04:51:45-05:00 hadrian: disable alloca for in-tree GMP on wasm32 When building in-tree GMP for wasm32, disable its alloca usage, since it may potentially cause stack overflow (e.g. #22602). - - - - - db0f1bfd by Cheng Shao at 2023-01-23T04:52:21-05:00 Bump process submodule Includes a critical fix for wasm32, see https://github.com/haskell/process/pull/272 for details. Also changes the existing cross test to include process stuff and avoid future regression here. - - - - - 9222b167 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Fix subdir for windows bindist - - - - - 9a9bec57 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Remove viPostRemove field from generated metadata This has been removed from the downstream metadata. - - - - - 82884ce0 by Simon Peyton Jones at 2023-01-23T04:53:32-05:00 Fix #22742 runtimeRepLevity_maybe was panicing unnecessarily; and the error printing code made use of the case when it should return Nothing rather than panicing. For some bizarre reason perf/compiler/T21839r shows a 10% bump in runtime peak-megagbytes-used, on a single architecture (alpine). See !9753 for commentary, but I'm going to accept it. Metric Increase: T21839r - - - - - 2c6deb18 by Bryan Richter at 2023-01-23T14:12:22+02:00 codeowners: Add Ben, Matt, and Bryan to CI - - - - - eee3bf05 by Matthew Craven at 2023-01-23T21:46:41-05:00 Do not collect compile-time metrics for T21839r ...the testsuite doesn't handle this properly since it also collects run-time metrics. Compile-time metrics for this test are already tracked via T21839c. Metric Decrease: T21839r - - - - - 1d1dd3fb by Matthew Pickering at 2023-01-24T05:37:52-05:00 Fix recompilation checking for multiple home units The key part of this change is to store a UnitId in the `UsageHomeModule` and `UsageHomeModuleInterface`. * Fine-grained dependency tracking is used if the dependency comes from any home unit. * We actually look up the right module when checking whether we need to recompile in the `UsageHomeModuleInterface` case. These scenarios are both checked by the new tests ( multipleHomeUnits_recomp and multipleHomeUnits_recomp_th ) Fixes #22675 - - - - - 7bfb30f9 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Augment target filepath by working directory when checking if module satisfies target This fixes a spurious warning in -Wmissing-home-modules. This is a simple oversight where when looking for the target in the first place we augment the search by the -working-directory flag but then fail to do so when checking this warning. Fixes #22676 - - - - - 69500dd4 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Use NodeKey rather than ModuleName in pruneCache The `pruneCache` function assumes that the list of `CachedInfo` all have unique `ModuleName`, this is not true: * In normal compilation, the same module name can appear for a file and it's boot file. * In multiple home unit compilation the same ModuleName can appear in different units The fix is to use a `NodeKey` as the actual key for the interfaces which includes `ModuleName`, `IsBoot` and `UnitId`. Fixes #22677 - - - - - 336b2b1c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Recompilation checking: Don't try to find artefacts for Interactive & hs-boot combo In interactive mode we don't produce any linkables for hs-boot files. So we also need to not going looking for them when we check to see if we have all the right objects needed for recompilation. Ticket #22669 - - - - - 6469fea7 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Don't write o-boot files in Interactive mode We should not be producing object files when in interactive mode but we still produced the dummy o-boot files. These never made it into a `Linkable` but then confused the recompilation checker. Fixes #22669 - - - - - 06cc0a95 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Improve driver diagnostic messages by including UnitId in message Currently the driver diagnostics don't give any indication about which unit they correspond to. For example `-Wmissing-home-modules` can fire multiple times for each different home unit and gives no indication about which unit it's actually reporting about. Perhaps a longer term fix is to generalise the providence information away from a SrcSpan so that these kind of whole project errors can be reported with an accurate provenance. For now we can just include the `UnitId` in the error message. Fixes #22678 - - - - - 4fe9eaff by Matthew Pickering at 2023-01-24T05:37:52-05:00 Key ModSummary cache by UnitId as well as FilePath Multiple units can refer to the same files without any problem. Just another assumption which needs to be updated when we may have multiple home units. However, there is the invariant that within each unit each file only maps to one module, so as long as we also key the cache by UnitId then we are all good. This led to some confusing behaviour in GHCi when reloading, multipleHomeUnits_shared distils the essence of what can go wrong. Fixes #22679 - - - - - ada29f5c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Finder: Look in current unit before looking in any home package dependencies In order to preserve existing behaviour it's important to look within the current component before consideirng a module might come from an external component. This already happened by accident in `downsweep`, (because roots are used to repopulated the cache) but in the `Finder` the logic was the wrong way around. Fixes #22680 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp -------------------------p - - - - - be701cc6 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Debug: Print full NodeKey when pretty printing ModuleGraphNode This is helpful when debugging multiple component issues. - - - - - 34d2d463 by Krzysztof Gogolewski at 2023-01-24T05:38:32-05:00 Fix Lint check for duplicate external names Lint was checking for duplicate external names by calling removeDups, which needs a comparison function that is passed to Data.List.sortBy. But the comparison was not a valid ordering - it returned LT if one of the names was not external. For example, the previous implementation won't find a duplicate in [M.x, y, M.x]. Instead, we filter out non-external names before looking for duplicates. - - - - - 1c050ed2 by Matthew Pickering at 2023-01-24T05:39:08-05:00 Add test for T22671 This was fixed by b13c6ea5 Closes #22671 - - - - - 05e6a2d9 by Tom Ellis at 2023-01-24T12:10:52-05:00 Clarify where `f` is defined - - - - - d151546e by Cheng Shao at 2023-01-24T12:11:29-05:00 CmmToC: fix CmmRegOff for 64-bit register on a 32-bit target We used to print the offset value to a platform word sized integer. This is incorrect when the offset is negative (e.g. output of cmm constant folding) and the register is 64-bit but on a 32-bit target, and may lead to incorrect runtime result (e.g. #22607). The fix is simple: just treat it as a proper MO_Add, with the correct width info inferred from the register itself. Metric Increase: T12707 T13379 T4801 T5321FD T5321Fun - - - - - 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 - - - - - 1bd32a35 by Sylvain Henry at 2023-01-26T12:34:21-05:00 Factorize hptModulesBelow Create and use moduleGraphModulesBelow in GHC.Unit.Module.Graph that doesn't need anything from the driver to be used. - - - - - 1262d3f8 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Store dehydrated data structures in CgModBreaks This fixes a tricky leak in GHCi where we were retaining old copies of HscEnvs when reloading. If not all modules were recompiled then these hydrated fields in break points would retain a reference to the old HscEnv which could double memory usage. Fixes #22530 - - - - - e27eb80c by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force more in NFData Name instance Doesn't force the lazy `OccName` field (#19619) which is already known as a really bad source of leaks. When we slam the hammer storing Names on disk (in interface files or the like), all this should be forced as otherwise a `Name` can easily retain an `Id` and hence the entire world. Fixes #22833 - - - - - 3d004d5a by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force OccName in tidyTopName This occname has just been derived from an `Id`, so need to force it promptly so we can release the Id back to the world. Another symptom of the bug caused by #19619 - - - - - f2a0fea0 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Strict fields in ModNodeKey (otherwise retains HomeModInfo) Towards #22530 - - - - - 5640cb1d by Sylvain Henry at 2023-01-26T12:35:36-05:00 Hadrian: fix doc generation Was missing dependencies on files generated by templates (e.g. ghc.cabal) - - - - - 3e827c3f by Richard Eisenberg at 2023-01-26T20:06:53-05:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. - - - - - b3ef5c89 by doyougnu at 2023-01-26T20:07:48-05:00 tryFillBuffer: strictify more speculative bangs - - - - - d0d7ba0f by Vladislav Zavialov at 2023-01-26T20:08:25-05:00 base: NoImplicitPrelude in Data.Void and Data.Kind This change removes an unnecessary dependency on Prelude from two modules in the base package. - - - - - fa1db923 by Matthew Pickering at 2023-01-26T20:09:00-05: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 - - - - - 807310a1 by Matthew Pickering at 2023-01-26T20:09:00-05:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. - - - - - c7116b10 by Ben Gamari at 2023-01-26T20:09:35-05:00 base: Make changelog proposal references more consistent Addresses #22773. - - - - - 6932cfc7 by Sylvain Henry at 2023-01-26T20:10:27-05:00 Fix spurious change from !9568 - - - - - e480fbc2 by Ben Gamari at 2023-01-27T05:01:24-05:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 - - - - - 2648c09c by Andrei Borzenkov at 2023-01-27T05:02:07-05:00 Replace errors from badOrigBinding with new one (#22839) Problem: in 02279a9c the type-level [] syntax was changed from a built-in name to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if a name is not built-in then it must have come from TH quotation, but this is not necessarily the case with []. The outdated assumption in badOrigBinding leads to incorrect error messages. This code: data [] Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []" Unfortunately, there is not enough information in RdrName to directly determine if the name was constructed via TH or by the parser, so this patch changes the error message instead. It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote into a new error TcRnBindingOfExistingName and changes its wording to avoid guessing the origin of the name. - - - - - 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 83703de2 by Josh Meredith at 2023-02-02T06:30:12+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 21a2a5bd by Josh Meredith at 2023-02-02T06:30:12+00:00 Add comment explaining the use of Emscripten's `stat` layout. - - - - - df4d001e by Josh Meredith at 2023-02-02T06:30:12+00:00 Add reference to issue 22573 to comment. - - - - - 5d9b8693 by Josh Meredith at 2023-02-02T06:30:12+00:00 Fix typo. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/hello.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - INSTALL.md - boot - cabal.project-reinstall - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Reg.hs - compiler/GHC/Cmm/Sink.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b385d86918322e3f6a297ac4bc2bba0e0fefbb63...5d9b869317b78c444ab6fcfce96ea177de001e2e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b385d86918322e3f6a297ac4bc2bba0e0fefbb63...5d9b869317b78c444ab6fcfce96ea177de001e2e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 06:30:29 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Thu, 02 Feb 2023 01:30:29 -0500 Subject: [Git][ghc/ghc][wip/js-rts-fixmes] 108 commits: codeowners: Add Ben, Matt, and Bryan to CI Message-ID: <63db58855d420_2a4f463a684415494d6@gitlab.mail> Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC Commits: 2c6deb18 by Bryan Richter at 2023-01-23T14:12:22+02:00 codeowners: Add Ben, Matt, and Bryan to CI - - - - - eee3bf05 by Matthew Craven at 2023-01-23T21:46:41-05:00 Do not collect compile-time metrics for T21839r ...the testsuite doesn't handle this properly since it also collects run-time metrics. Compile-time metrics for this test are already tracked via T21839c. Metric Decrease: T21839r - - - - - 1d1dd3fb by Matthew Pickering at 2023-01-24T05:37:52-05:00 Fix recompilation checking for multiple home units The key part of this change is to store a UnitId in the `UsageHomeModule` and `UsageHomeModuleInterface`. * Fine-grained dependency tracking is used if the dependency comes from any home unit. * We actually look up the right module when checking whether we need to recompile in the `UsageHomeModuleInterface` case. These scenarios are both checked by the new tests ( multipleHomeUnits_recomp and multipleHomeUnits_recomp_th ) Fixes #22675 - - - - - 7bfb30f9 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Augment target filepath by working directory when checking if module satisfies target This fixes a spurious warning in -Wmissing-home-modules. This is a simple oversight where when looking for the target in the first place we augment the search by the -working-directory flag but then fail to do so when checking this warning. Fixes #22676 - - - - - 69500dd4 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Use NodeKey rather than ModuleName in pruneCache The `pruneCache` function assumes that the list of `CachedInfo` all have unique `ModuleName`, this is not true: * In normal compilation, the same module name can appear for a file and it's boot file. * In multiple home unit compilation the same ModuleName can appear in different units The fix is to use a `NodeKey` as the actual key for the interfaces which includes `ModuleName`, `IsBoot` and `UnitId`. Fixes #22677 - - - - - 336b2b1c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Recompilation checking: Don't try to find artefacts for Interactive & hs-boot combo In interactive mode we don't produce any linkables for hs-boot files. So we also need to not going looking for them when we check to see if we have all the right objects needed for recompilation. Ticket #22669 - - - - - 6469fea7 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Don't write o-boot files in Interactive mode We should not be producing object files when in interactive mode but we still produced the dummy o-boot files. These never made it into a `Linkable` but then confused the recompilation checker. Fixes #22669 - - - - - 06cc0a95 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Improve driver diagnostic messages by including UnitId in message Currently the driver diagnostics don't give any indication about which unit they correspond to. For example `-Wmissing-home-modules` can fire multiple times for each different home unit and gives no indication about which unit it's actually reporting about. Perhaps a longer term fix is to generalise the providence information away from a SrcSpan so that these kind of whole project errors can be reported with an accurate provenance. For now we can just include the `UnitId` in the error message. Fixes #22678 - - - - - 4fe9eaff by Matthew Pickering at 2023-01-24T05:37:52-05:00 Key ModSummary cache by UnitId as well as FilePath Multiple units can refer to the same files without any problem. Just another assumption which needs to be updated when we may have multiple home units. However, there is the invariant that within each unit each file only maps to one module, so as long as we also key the cache by UnitId then we are all good. This led to some confusing behaviour in GHCi when reloading, multipleHomeUnits_shared distils the essence of what can go wrong. Fixes #22679 - - - - - ada29f5c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Finder: Look in current unit before looking in any home package dependencies In order to preserve existing behaviour it's important to look within the current component before consideirng a module might come from an external component. This already happened by accident in `downsweep`, (because roots are used to repopulated the cache) but in the `Finder` the logic was the wrong way around. Fixes #22680 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp -------------------------p - - - - - be701cc6 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Debug: Print full NodeKey when pretty printing ModuleGraphNode This is helpful when debugging multiple component issues. - - - - - 34d2d463 by Krzysztof Gogolewski at 2023-01-24T05:38:32-05:00 Fix Lint check for duplicate external names Lint was checking for duplicate external names by calling removeDups, which needs a comparison function that is passed to Data.List.sortBy. But the comparison was not a valid ordering - it returned LT if one of the names was not external. For example, the previous implementation won't find a duplicate in [M.x, y, M.x]. Instead, we filter out non-external names before looking for duplicates. - - - - - 1c050ed2 by Matthew Pickering at 2023-01-24T05:39:08-05:00 Add test for T22671 This was fixed by b13c6ea5 Closes #22671 - - - - - 05e6a2d9 by Tom Ellis at 2023-01-24T12:10:52-05:00 Clarify where `f` is defined - - - - - d151546e by Cheng Shao at 2023-01-24T12:11:29-05:00 CmmToC: fix CmmRegOff for 64-bit register on a 32-bit target We used to print the offset value to a platform word sized integer. This is incorrect when the offset is negative (e.g. output of cmm constant folding) and the register is 64-bit but on a 32-bit target, and may lead to incorrect runtime result (e.g. #22607). The fix is simple: just treat it as a proper MO_Add, with the correct width info inferred from the register itself. Metric Increase: T12707 T13379 T4801 T5321FD T5321Fun - - - - - 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 - - - - - 1bd32a35 by Sylvain Henry at 2023-01-26T12:34:21-05:00 Factorize hptModulesBelow Create and use moduleGraphModulesBelow in GHC.Unit.Module.Graph that doesn't need anything from the driver to be used. - - - - - 1262d3f8 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Store dehydrated data structures in CgModBreaks This fixes a tricky leak in GHCi where we were retaining old copies of HscEnvs when reloading. If not all modules were recompiled then these hydrated fields in break points would retain a reference to the old HscEnv which could double memory usage. Fixes #22530 - - - - - e27eb80c by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force more in NFData Name instance Doesn't force the lazy `OccName` field (#19619) which is already known as a really bad source of leaks. When we slam the hammer storing Names on disk (in interface files or the like), all this should be forced as otherwise a `Name` can easily retain an `Id` and hence the entire world. Fixes #22833 - - - - - 3d004d5a by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force OccName in tidyTopName This occname has just been derived from an `Id`, so need to force it promptly so we can release the Id back to the world. Another symptom of the bug caused by #19619 - - - - - f2a0fea0 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Strict fields in ModNodeKey (otherwise retains HomeModInfo) Towards #22530 - - - - - 5640cb1d by Sylvain Henry at 2023-01-26T12:35:36-05:00 Hadrian: fix doc generation Was missing dependencies on files generated by templates (e.g. ghc.cabal) - - - - - 3e827c3f by Richard Eisenberg at 2023-01-26T20:06:53-05:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. - - - - - b3ef5c89 by doyougnu at 2023-01-26T20:07:48-05:00 tryFillBuffer: strictify more speculative bangs - - - - - d0d7ba0f by Vladislav Zavialov at 2023-01-26T20:08:25-05:00 base: NoImplicitPrelude in Data.Void and Data.Kind This change removes an unnecessary dependency on Prelude from two modules in the base package. - - - - - fa1db923 by Matthew Pickering at 2023-01-26T20:09:00-05: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 - - - - - 807310a1 by Matthew Pickering at 2023-01-26T20:09:00-05:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. - - - - - c7116b10 by Ben Gamari at 2023-01-26T20:09:35-05:00 base: Make changelog proposal references more consistent Addresses #22773. - - - - - 6932cfc7 by Sylvain Henry at 2023-01-26T20:10:27-05:00 Fix spurious change from !9568 - - - - - e480fbc2 by Ben Gamari at 2023-01-27T05:01:24-05:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 - - - - - 2648c09c by Andrei Borzenkov at 2023-01-27T05:02:07-05:00 Replace errors from badOrigBinding with new one (#22839) Problem: in 02279a9c the type-level [] syntax was changed from a built-in name to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if a name is not built-in then it must have come from TH quotation, but this is not necessarily the case with []. The outdated assumption in badOrigBinding leads to incorrect error messages. This code: data [] Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []" Unfortunately, there is not enough information in RdrName to directly determine if the name was constructed via TH or by the parser, so this patch changes the error message instead. It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote into a new error TcRnBindingOfExistingName and changes its wording to avoid guessing the origin of the name. - - - - - 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 0422c809 by Josh Meredith at 2023-02-02T06:30:15+00:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} - - - - - fd7b4cfc by Josh Meredith at 2023-02-02T06:30:15+00:00 Cache names used commonly in JS backend RTS generation - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - CODEOWNERS - INSTALL.md - cabal.project-reinstall - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Reg.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/49da12e38fe302c0c6a3db34377090d21fd2429e...fd7b4cfc98109df154824cf82ff8b3c5834cbb04 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/49da12e38fe302c0c6a3db34377090d21fd2429e...fd7b4cfc98109df154824cf82ff8b3c5834cbb04 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 07:15:25 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Thu, 02 Feb 2023 02:15:25 -0500 Subject: [Git][ghc/ghc][wip/js-rts-fixmes] Cache names used commonly in JS backend RTS generation Message-ID: <63db630d8e9bc_2a4f599cf8481552236@gitlab.mail> Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC Commits: f18e08a1 by Josh Meredith at 2023-02-02T07:14:49+00:00 Cache names used commonly in JS backend RTS generation - - - - - 2 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -129,7 +129,10 @@ module GHC.JS.Make -- * Miscellaneous -- $misc , allocData, allocClsA + , dataName + , clsName , dataFieldName, dataFieldNames + , varName, varNames ) where @@ -646,7 +649,7 @@ nFieldCache = 16384 dataFieldName :: Int -> FastString dataFieldName i - | i < 1 || i > nFieldCache = panic "dataFieldName" (ppr i) + | i < 0 || i > nFieldCache = panic "dataFieldName" (ppr i) | otherwise = dataFieldCache ! i dataFieldNames :: [FastString] @@ -657,6 +660,11 @@ dataFieldNames = fmap dataFieldName [1..nFieldCache] dataCache :: Array Int FastString dataCache = listArray (0,1024) (map (mkFastString . ("h$d"++) . show) [(0::Int)..1024]) +dataName :: Int -> FastString +dataName i + | i < 0 || i > 1024 = panic "dataCacheName" (ppr i) + | otherwise = dataCache ! i + allocData :: Int -> JExpr allocData i = toJExpr (TxtI (dataCache ! i)) @@ -664,9 +672,26 @@ allocData i = toJExpr (TxtI (dataCache ! i)) clsCache :: Array Int FastString clsCache = listArray (0,1024) (map (mkFastString . ("h$c"++) . show) [(0::Int)..1024]) +clsName :: Int -> FastString +clsName i + | i < 0 || i > 1024 = panic "clsCacheName" (ppr i) + | otherwise = clsCache ! i + allocClsA :: Int -> JExpr allocClsA i = toJExpr (TxtI (clsCache ! i)) +-- | Cache "xXXX" names +varCache :: Array Int FastString +varCache = listArray (0,1024) (map (mkFastString . ('x':) . show) [(0::Int)..1024]) + +varName :: Int -> Ident +varName i + | i < 0 || i > 1024 = panic "varCacheName" (ppr i) + | otherwise = TxtI $ varCache ! i + +varNames :: [Ident] +varNames = fmap varName [1..1024] + -------------------------------------------------------------------------------- -- New Identifiers ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -149,15 +149,15 @@ closureConstructors s = BlockStat where n | Just n' <- n0 = n' | Nothing <- n0 = 0 - funName | Just n' <- n0 = TxtI $ mkFastString ("h$c" ++ show n') + funName | Just n' <- n0 = TxtI $ clsName n' | Nothing <- n0 = TxtI $ mkFastString "h$c" -- args are: f x1 x2 .. xn [cc] - args = TxtI "f" : addCCArg' (map (TxtI . mkFastString . ('x':) . show) [(1::Int)..n]) + args = TxtI "f" : addCCArg' (take n varNames) fun = JFunc args funBod -- x1 goes into closureField1. All the other args are bundled into an -- object in closureField2: { d1 = x2, d2 = x3, ... } -- - vars = map (var . mkFastString . ('x':) . show) [1..n] + vars = map toJExpr $ take n varNames x1 = case vars of [] -> null_ @@ -166,9 +166,7 @@ closureConstructors s = BlockStat [] -> null_ [_] -> null_ [_,x] -> x - _:x:xs -> ValExpr . JHash . listToUniqMap $ zip - (map (mkFastString . ('d':) . show) [(1::Int)..]) - (x:xs) + _:x:xs -> ValExpr . JHash . listToUniqMap $ zip dataFieldNames (x:xs) funBod = jVar $ \x -> [ checkC @@ -187,10 +185,9 @@ closureConstructors s = BlockStat mkDataFill :: Int -> JStat mkDataFill n = funName ||= toJExpr fun where - funName = TxtI $ mkFastString ("h$d" ++ show n) - ds = map (mkFastString . ('d':) . show) [(1::Int)..n] - extra_args = ValExpr . JHash . listToUniqMap . zip ds $ map (toJExpr . TxtI) ds - fun = JFunc (map TxtI ds) (checkD <> returnS extra_args) + funName = TxtI $ dataName n + extra_args = ValExpr . JHash . listToUniqMap . zip dataFieldNames $ map (toJExpr . TxtI) dataFieldNames + fun = JFunc (map TxtI dataFieldNames) (checkD <> returnS extra_args) -- | JS Payload to perform stack manipulation in the RTS stackManip :: JStat @@ -199,7 +196,7 @@ stackManip = mconcat (map mkPush [1..32]) <> where mkPush :: Int -> JStat mkPush n = let funName = TxtI $ mkFastString ("h$p" ++ show n) - as = map (TxtI . mkFastString . ('x':) . show) [1..n] + as = take n varNames fun = JFunc as ((sp |= sp + toJExpr n) <> mconcat (zipWith (\i a -> stack .! (sp - toJExpr (n-i)) |= toJExpr a) [1..] as)) @@ -212,7 +209,7 @@ stackManip = mconcat (map mkPush [1..32]) <> bits = bitsIdx sig n = length bits h = last bits - args = map (TxtI . mkFastString . ('x':) . show) [1..n] + args = take n varNames fun = JFunc args $ mconcat [ sp |= sp + toJExpr (h+1) , mconcat (zipWith (\b a -> stack .! (sp - toJExpr (h-b)) |= toJExpr a) bits args) @@ -272,7 +269,7 @@ loadRegs :: JStat loadRegs = mconcat $ map mkLoad [1..32] where mkLoad :: Int -> JStat - mkLoad n = let args = map (TxtI . mkFastString . ("x"++) . show) [1..n] + mkLoad n = let args = take n varNames assign = zipWith (\a r -> toJExpr r |= toJExpr a) args (reverse $ take n regsFromR1) fname = TxtI $ mkFastString ("h$l" ++ show n) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f18e08a11c103f96d432cc769e3cbf5ccb31d083 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f18e08a11c103f96d432cc769e3cbf5ccb31d083 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 07:31:31 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Thu, 02 Feb 2023 02:31:31 -0500 Subject: [Git][ghc/ghc][wip/js-rts-fixmes] Cache names used commonly in JS backend RTS generation Message-ID: <63db66d3e33fb_2a4fa049e441555086@gitlab.mail> Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC Commits: bc14c389 by Josh Meredith at 2023-02-02T07:31:08+00:00 Cache names used commonly in JS backend RTS generation - - - - - 2 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -129,7 +129,10 @@ module GHC.JS.Make -- * Miscellaneous -- $misc , allocData, allocClsA + , dataName + , clsName , dataFieldName, dataFieldNames + , varName, varNames ) where @@ -646,7 +649,7 @@ nFieldCache = 16384 dataFieldName :: Int -> FastString dataFieldName i - | i < 1 || i > nFieldCache = panic "dataFieldName" (ppr i) + | i < 0 || i > nFieldCache = panic "dataFieldName" (ppr i) | otherwise = dataFieldCache ! i dataFieldNames :: [FastString] @@ -657,6 +660,11 @@ dataFieldNames = fmap dataFieldName [1..nFieldCache] dataCache :: Array Int FastString dataCache = listArray (0,1024) (map (mkFastString . ("h$d"++) . show) [(0::Int)..1024]) +dataName :: Int -> FastString +dataName i + | i < 0 || i > 1024 = panic "dataCacheName" (ppr i) + | otherwise = dataCache ! i + allocData :: Int -> JExpr allocData i = toJExpr (TxtI (dataCache ! i)) @@ -664,9 +672,26 @@ allocData i = toJExpr (TxtI (dataCache ! i)) clsCache :: Array Int FastString clsCache = listArray (0,1024) (map (mkFastString . ("h$c"++) . show) [(0::Int)..1024]) +clsName :: Int -> FastString +clsName i + | i < 0 || i > 1024 = panic "clsCacheName" (ppr i) + | otherwise = clsCache ! i + allocClsA :: Int -> JExpr allocClsA i = toJExpr (TxtI (clsCache ! i)) +-- | Cache "xXXX" names +varCache :: Array Int FastString +varCache = listArray (0,1024) (map (mkFastString . ('x':) . show) [(0::Int)..1024]) + +varName :: Int -> Ident +varName i + | i < 0 || i > 1024 = panic "varCacheName" (ppr i) + | otherwise = TxtI $ varCache ! i + +varNames :: [Ident] +varNames = fmap varName [1..1024] + -------------------------------------------------------------------------------- -- New Identifiers ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -90,19 +90,8 @@ closureConstructors s = BlockStat -- the cc argument happens to be named just like the cc field... | prof = ([TxtI closureCC_], Just (var closureCC_)) | otherwise = ([], Nothing) - addCCArg as = map TxtI as ++ ccArg addCCArg' as = as ++ ccArg - declClsConstr i as cl = TxtI i ||= ValExpr (JFunc (addCCArg as) - ( jVar $ \x -> - [ checkC - , x |= newClosure cl - , notifyAlloc x - , traceAlloc x - , returnS x - ] - )) - traceAlloc x | csTraceRts s = appS "h$traceAlloc" [x] | otherwise = mempty @@ -149,15 +138,15 @@ closureConstructors s = BlockStat where n | Just n' <- n0 = n' | Nothing <- n0 = 0 - funName | Just n' <- n0 = TxtI $ mkFastString ("h$c" ++ show n') + funName | Just n' <- n0 = TxtI $ clsName n' | Nothing <- n0 = TxtI $ mkFastString "h$c" -- args are: f x1 x2 .. xn [cc] - args = TxtI "f" : addCCArg' (map (TxtI . mkFastString . ('x':) . show) [(1::Int)..n]) + args = TxtI "f" : addCCArg' (take n varNames) fun = JFunc args funBod -- x1 goes into closureField1. All the other args are bundled into an -- object in closureField2: { d1 = x2, d2 = x3, ... } -- - vars = map (var . mkFastString . ('x':) . show) [1..n] + vars = map toJExpr $ take n varNames x1 = case vars of [] -> null_ @@ -166,9 +155,7 @@ closureConstructors s = BlockStat [] -> null_ [_] -> null_ [_,x] -> x - _:x:xs -> ValExpr . JHash . listToUniqMap $ zip - (map (mkFastString . ('d':) . show) [(1::Int)..]) - (x:xs) + _:x:xs -> ValExpr . JHash . listToUniqMap $ zip dataFieldNames (x:xs) funBod = jVar $ \x -> [ checkC @@ -187,10 +174,9 @@ closureConstructors s = BlockStat mkDataFill :: Int -> JStat mkDataFill n = funName ||= toJExpr fun where - funName = TxtI $ mkFastString ("h$d" ++ show n) - ds = map (mkFastString . ('d':) . show) [(1::Int)..n] - extra_args = ValExpr . JHash . listToUniqMap . zip ds $ map (toJExpr . TxtI) ds - fun = JFunc (map TxtI ds) (checkD <> returnS extra_args) + funName = TxtI $ dataName n + extra_args = ValExpr . JHash . listToUniqMap . zip dataFieldNames $ map (toJExpr . TxtI) dataFieldNames + fun = JFunc (map TxtI dataFieldNames) (checkD <> returnS extra_args) -- | JS Payload to perform stack manipulation in the RTS stackManip :: JStat @@ -199,7 +185,7 @@ stackManip = mconcat (map mkPush [1..32]) <> where mkPush :: Int -> JStat mkPush n = let funName = TxtI $ mkFastString ("h$p" ++ show n) - as = map (TxtI . mkFastString . ('x':) . show) [1..n] + as = take n varNames fun = JFunc as ((sp |= sp + toJExpr n) <> mconcat (zipWith (\i a -> stack .! (sp - toJExpr (n-i)) |= toJExpr a) [1..] as)) @@ -212,7 +198,7 @@ stackManip = mconcat (map mkPush [1..32]) <> bits = bitsIdx sig n = length bits h = last bits - args = map (TxtI . mkFastString . ('x':) . show) [1..n] + args = take n varNames fun = JFunc args $ mconcat [ sp |= sp + toJExpr (h+1) , mconcat (zipWith (\b a -> stack .! (sp - toJExpr (h-b)) |= toJExpr a) bits args) @@ -272,7 +258,7 @@ loadRegs :: JStat loadRegs = mconcat $ map mkLoad [1..32] where mkLoad :: Int -> JStat - mkLoad n = let args = map (TxtI . mkFastString . ("x"++) . show) [1..n] + mkLoad n = let args = take n varNames assign = zipWith (\a r -> toJExpr r |= toJExpr a) args (reverse $ take n regsFromR1) fname = TxtI $ mkFastString ("h$l" ++ show n) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bc14c389743bcf0f58cc3d73370d40738ab92181 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bc14c389743bcf0f58cc3d73370d40738ab92181 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 09:20:17 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Thu, 02 Feb 2023 04:20:17 -0500 Subject: [Git][ghc/ghc][wip/js-rts-fixmes] Re-enable unexpected passes fixed by JS FileState changes Message-ID: <63db80513c21e_2a4f58fd77281569566@gitlab.mail> Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC Commits: c5fc3b65 by Josh Meredith at 2023-02-02T09:19:54+00:00 Re-enable unexpected passes fixed by JS FileState changes - - - - - 3 changed files: - testsuite/tests/callarity/unittest/all.T - testsuite/tests/corelint/all.T - testsuite/tests/ghc-api/all.T Changes: ===================================== testsuite/tests/callarity/unittest/all.T ===================================== @@ -5,4 +5,4 @@ setTestOpts(f) setTestOpts(extra_hc_opts('-package ghc')) setTestOpts(extra_run_opts('"' + config.libdir + '"')) -test('CallArity1', js_broken(22362), compile_and_run, ['']) +test('CallArity1', normal, compile_and_run, ['']) ===================================== testsuite/tests/corelint/all.T ===================================== @@ -7,6 +7,6 @@ test('T21152', normal, compile, ['-g3']) setTestOpts(extra_hc_opts('-package ghc')) setTestOpts(extra_run_opts('"' + config.libdir + '"')) -test('LintEtaExpand', js_broken(22362), compile_and_run, ['']) +test('LintEtaExpand', normal, compile_and_run, ['']) ## These tests use the GHC API. ## Test cases which don't use the GHC API should be added nearer the top. ===================================== testsuite/tests/ghc-api/all.T ===================================== @@ -4,14 +4,14 @@ test('T8639_api', req_rts_linker, makefile_test, ['T8639_api']) test('T8628', req_rts_linker, makefile_test, ['T8628']) -test('T9595', [extra_run_opts('"' + config.libdir + '"'), js_broken(22362)], +test('T9595', [extra_run_opts('"' + config.libdir + '"')], compile_and_run, ['-package ghc']) test('T10508_api', [ extra_run_opts('"' + config.libdir + '"'), req_rts_linker ], compile_and_run, ['-package ghc']) -test('T10942', [extra_run_opts('"' + config.libdir + '"'), js_broken(22362)], +test('T10942', [extra_run_opts('"' + config.libdir + '"')], compile_and_run, ['-package ghc']) test('T9015', extra_run_opts('"' + config.libdir + '"'), @@ -26,7 +26,7 @@ test('T18181', compile_and_run, ['-package ghc']) test('T18522-dbg-ppr', - [extra_run_opts('"' + config.libdir + '"'), js_broken(22362)], + [extra_run_opts('"' + config.libdir + '"')], compile_and_run, ['-package ghc']) test('T19156', [ extra_run_opts('"' + config.libdir + '"') View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c5fc3b653a60bec1dfa7172a5f7091c72e407b39 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c5fc3b653a60bec1dfa7172a5f7091c72e407b39 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 09:23:26 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Thu, 02 Feb 2023 04:23:26 -0500 Subject: [Git][ghc/ghc][wip/js-rts-fixmes] Deleted 1 commit: Re-enable unexpected passes fixed by JS FileState changes Message-ID: <63db810eee5ed_2a4fa049e4415699e5@gitlab.mail> Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC WARNING: The push did not contain any new commits, but force pushed to delete the commits and changes below. Deleted commits: c5fc3b65 by Josh Meredith at 2023-02-02T09:19:54+00:00 Re-enable unexpected passes fixed by JS FileState changes - - - - - 3 changed files: - testsuite/tests/callarity/unittest/all.T - testsuite/tests/corelint/all.T - testsuite/tests/ghc-api/all.T Changes: ===================================== testsuite/tests/callarity/unittest/all.T ===================================== @@ -5,4 +5,4 @@ setTestOpts(f) setTestOpts(extra_hc_opts('-package ghc')) setTestOpts(extra_run_opts('"' + config.libdir + '"')) -test('CallArity1', js_broken(22362), compile_and_run, ['']) +test('CallArity1', normal, compile_and_run, ['']) ===================================== testsuite/tests/corelint/all.T ===================================== @@ -7,6 +7,6 @@ test('T21152', normal, compile, ['-g3']) setTestOpts(extra_hc_opts('-package ghc')) setTestOpts(extra_run_opts('"' + config.libdir + '"')) -test('LintEtaExpand', js_broken(22362), compile_and_run, ['']) +test('LintEtaExpand', normal, compile_and_run, ['']) ## These tests use the GHC API. ## Test cases which don't use the GHC API should be added nearer the top. ===================================== testsuite/tests/ghc-api/all.T ===================================== @@ -4,14 +4,14 @@ test('T8639_api', req_rts_linker, makefile_test, ['T8639_api']) test('T8628', req_rts_linker, makefile_test, ['T8628']) -test('T9595', [extra_run_opts('"' + config.libdir + '"'), js_broken(22362)], +test('T9595', [extra_run_opts('"' + config.libdir + '"')], compile_and_run, ['-package ghc']) test('T10508_api', [ extra_run_opts('"' + config.libdir + '"'), req_rts_linker ], compile_and_run, ['-package ghc']) -test('T10942', [extra_run_opts('"' + config.libdir + '"'), js_broken(22362)], +test('T10942', [extra_run_opts('"' + config.libdir + '"')], compile_and_run, ['-package ghc']) test('T9015', extra_run_opts('"' + config.libdir + '"'), @@ -26,7 +26,7 @@ test('T18181', compile_and_run, ['-package ghc']) test('T18522-dbg-ppr', - [extra_run_opts('"' + config.libdir + '"'), js_broken(22362)], + [extra_run_opts('"' + config.libdir + '"')], compile_and_run, ['-package ghc']) test('T19156', [ extra_run_opts('"' + config.libdir + '"') View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c5fc3b653a60bec1dfa7172a5f7091c72e407b39 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c5fc3b653a60bec1dfa7172a5f7091c72e407b39 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 09:27:29 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 02 Feb 2023 04:27:29 -0500 Subject: [Git][ghc/ghc] Deleted branch wip/mp-backports-9.6 Message-ID: <63db8201d4993_2a4fa049e441571944@gitlab.mail> Matthew Pickering deleted branch wip/mp-backports-9.6 at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 09:27:31 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 02 Feb 2023 04:27:31 -0500 Subject: [Git][ghc/ghc][ghc-9.6] 34 commits: ghc-the-library: Retain cafs in both static in dynamic builds. Message-ID: <63db820359f8e_2a4f3b9c710c15721c0@gitlab.mail> Matthew Pickering pushed to branch ghc-9.6 at Glasgow Haskell Compiler / GHC Commits: f9b50be4 by Andreas Klebinger at 2023-02-01T10:24:41+00:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- (cherry picked from commit 08ba87200ff068aa37cac082e61ee7e2d534daf5) - - - - - 4ed5ea30 by Richard Eisenberg at 2023-02-01T10:43:36+00:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. (cherry picked from commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90) - - - - - 31b63c46 by Alan Zimmerman at 2023-02-01T10:48:59+00:00 EPA: exact print HsDocTy To match ghc-exactprint https://github.com/alanz/ghc-exactprint/pull/121 (cherry picked from commit 965a273510adfac4f041a31182c2fec82e614e47) - - - - - f19eb3ac by Alan Zimmerman at 2023-02-01T10:51:36+00:00 EPA: Add annotation for 'type' in DataDecl Closes #22765 (cherry picked from commit 97ac8230b0a645aae27b7ee42aa55b0c84735684) - - - - - 686350e9 by Alan Zimmerman at 2023-02-01T13:18:46+00:00 EPA: Add SourceText to HsOverLabel To be able to capture string literals with possible escape codes as labels. Close #22771 (cherry picked from commit fec7c2ea8242773b53b253d9536426f743443944) - - - - - 9cdab037 by Ben Gamari at 2023-02-01T13:18:46+00:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 (cherry picked from commit e480fbc2c6fdcb252847fc537ab7ec50d1dc2dfd) - - - - - be39064e by Ben Gamari at 2023-02-01T13:18:46+00:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. (cherry picked from commit 56c1bd986ac13e3a1fe1149f011480e44f857f5a) - - - - - 80a6bb73 by nineonine at 2023-02-01T13:18:46+00:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. (cherry picked from commit b3a3534b6f75b34dc4db76e904e071485da6d5cc) - - - - - 3c21d69d by Ben Gamari at 2023-02-01T13:18:46+00:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. (cherry picked from commit be417a47c7695998dea0adc05489a7b8838a78b6) - - - - - ac6c24f7 by Ben Gamari at 2023-02-01T13:18:46+00:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. (cherry picked from commit 30989d137b8f3a8fddbfd116e04b48f23c24f86c) - - - - - 6c212ccc by Ben Gamari at 2023-02-01T13:18:46+00:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. (cherry picked from commit 7566fd9de38c67360c090f828923d41587af519c) - - - - - 79241b6d by Ben Gamari at 2023-02-01T13:18:46+00:00 testsuite: Add regression test for #22798 (cherry picked from commit 2cb500a5ee1a31dfe1a2cdd71f175442026eb082) - - - - - d9e8c39d by Simon Peyton Jones at 2023-02-01T13:18:46+00:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 (cherry picked from commit 638277ba7bd2683f539afb0bf469fe75376994e2) - - - - - 86dc9a79 by Zubin Duggal at 2023-02-01T13:18:46+00:00 bindist configure: Fail if find not found (#22691) (cherry picked from commit c9967d137cff83c7688e26f87a8b5e196a75ec93) - - - - - 86d88743 by Oleg Grenrus at 2023-02-01T13:18:47+00:00 Add Foldable1 Solo instance (cherry picked from commit 082b7d43ee4b8203dc9bca53e5e1f7a45c42eeb8) - - - - - 2eb49ea6 by Krzysztof Gogolewski at 2023-02-01T13:18:47+00:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 (cherry picked from commit f83374f8649e5d8413e7ed585b0e058690c38563) - - - - - 632937bb by Ryan Scott at 2023-02-01T13:18:47+00:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. (cherry picked from commit 20598ef6d9e26e2e0af9ac42a42e7be00d7cc4f3) - - - - - 2efb886c by Ryan Scott at 2023-02-01T13:18:47+00:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. (cherry picked from commit 2f1450521b816a7d287b72deba14d59b6ccfbdbf) - - - - - fc117e3d by Ben Gamari at 2023-02-01T13:18:47+00:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. (cherry picked from commit a2d814dc84dbdcdb6c1e274b8bd7c212cc98c39e) - - - - - 6e1498fa by Ben Gamari at 2023-02-01T13:18:47+00:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. (cherry picked from commit f838815c365773a8107bf035a8ec27b8ff6ecc8b) - - - - - 1f42664c by Ben Gamari at 2023-02-01T13:18:47+00:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. (cherry picked from commit 2e48c19a7faf975318e954faea26f37deb763ac0) - - - - - 653c7513 by Ben Gamari at 2023-02-01T13:18:47+00:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. (cherry picked from commit 93f0e3c49cea484bd6e838892ff8702ec51f34c3) - - - - - 3ac79844 by Simon Peyton Jones at 2023-02-01T13:18:47+00:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) (cherry picked from commit d0f34f25ceaae9ef0a21f15f811469d0bed9da69) - - - - - fb186399 by Bodigrim at 2023-02-01T13:18:47+00:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} (cherry picked from commit c9ad8852bdd083f8692361134bc247a1eb2bbd77) - - - - - fdfd8911 by Cheng Shao at 2023-02-01T13:18:47+00:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. (cherry picked from commit 7e11c6dc25cb9dd14ae33ee9715ddbc8ebf9836e) - - - - - adf17604 by Cheng Shao at 2023-02-01T13:18:47+00:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. (cherry picked from commit 6ea2aa0293aedea2f873b7b5d9cff5e7b9e2f188) - - - - - 329097fc by Matthew Pickering at 2023-02-01T13:18:47+00:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 (cherry picked from commit 7cbdaad0396cee561f125c95f3352cebabd8ed99) - - - - - 5695611e by Cheng Shao at 2023-02-01T13:18:47+00:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. (cherry picked from commit 78c07219d5dad9730bbe3ec26ad22912ff22f058) - - - - - c4cc32d9 by Cheng Shao at 2023-02-01T13:18:47+00:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. (cherry picked from commit da468391872f6be286db37a0f016a37f9f362509) - - - - - 8f29bdae by Cheng Shao at 2023-02-01T13:18:47+00:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. (cherry picked from commit fd8f32bf551c34b95275ebb4fe648680013156f3) - - - - - 343c856f by Cheng Shao at 2023-02-01T13:18:47+00:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. (cherry picked from commit 7716cbe64862932fd69348b2594a14f2092e1c02) - - - - - e377aa49 by Ben Gamari at 2023-02-01T13:18:47+00:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. (cherry picked from commit 22089f693cf6e662a58a7011adb94d7f768ad2d7) - - - - - d91e6233 by Cheng Shao at 2023-02-01T13:18:47+00:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. (cherry picked from commit f0eefa3cf058879246991747dcd18c811402f9e5) - - - - - 30d3c827 by Ben Gamari at 2023-02-01T13:18:47+00:00 nativeGen/X86: MFENCE is unnecessary for release semantics In #22764 a user noticed that a program implementing a simple atomic counter via an STRef regressed significantly due to the introduction of necessary atomic operations in the MutVar# primops (#22468). This regression was caused by a bug in the NCG, which emitted an unnecessary MFENCE instruction for a release-ordered atomic write. MFENCE is rather only needed to achieve sequentially consistent ordering. Fixes #22764. (cherry picked from commit f058e3672b969f301b6b1637f8ab081654ec947a) - - - - - 30 changed files: - .gitlab-ci.yml - cabal.project-reinstall - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToAsm/Wasm/Utils.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Foreign/C.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/IfaceToCore.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/19a68c780d99687e7eb0bb9ab1bb7018ef671006...30d3c8271b867ff9d6c2514632632b9483a09056 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/19a68c780d99687e7eb0bb9ab1bb7018ef671006...30d3c8271b867ff9d6c2514632632b9483a09056 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 09:30:00 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Thu, 02 Feb 2023 04:30:00 -0500 Subject: [Git][ghc/ghc][wip/js-fileStat] Re-enable unexpected passes fixed by JS FileStat changes Message-ID: <63db8298eb38_2a4f55f501572534@gitlab.mail> Josh Meredith pushed to branch wip/js-fileStat at Glasgow Haskell Compiler / GHC Commits: 3505c412 by Josh Meredith at 2023-02-02T09:29:46+00:00 Re-enable unexpected passes fixed by JS FileStat changes - - - - - 3 changed files: - testsuite/tests/callarity/unittest/all.T - testsuite/tests/corelint/all.T - testsuite/tests/ghc-api/all.T Changes: ===================================== testsuite/tests/callarity/unittest/all.T ===================================== @@ -5,4 +5,4 @@ setTestOpts(f) setTestOpts(extra_hc_opts('-package ghc')) setTestOpts(extra_run_opts('"' + config.libdir + '"')) -test('CallArity1', js_broken(22362), compile_and_run, ['']) +test('CallArity1', normal, compile_and_run, ['']) ===================================== testsuite/tests/corelint/all.T ===================================== @@ -7,6 +7,6 @@ test('T21152', normal, compile, ['-g3']) setTestOpts(extra_hc_opts('-package ghc')) setTestOpts(extra_run_opts('"' + config.libdir + '"')) -test('LintEtaExpand', js_broken(22362), compile_and_run, ['']) +test('LintEtaExpand', normal, compile_and_run, ['']) ## These tests use the GHC API. ## Test cases which don't use the GHC API should be added nearer the top. ===================================== testsuite/tests/ghc-api/all.T ===================================== @@ -4,14 +4,14 @@ test('T8639_api', req_rts_linker, makefile_test, ['T8639_api']) test('T8628', req_rts_linker, makefile_test, ['T8628']) -test('T9595', [extra_run_opts('"' + config.libdir + '"'), js_broken(22362)], +test('T9595', [extra_run_opts('"' + config.libdir + '"')], compile_and_run, ['-package ghc']) test('T10508_api', [ extra_run_opts('"' + config.libdir + '"'), req_rts_linker ], compile_and_run, ['-package ghc']) -test('T10942', [extra_run_opts('"' + config.libdir + '"'), js_broken(22362)], +test('T10942', [extra_run_opts('"' + config.libdir + '"')], compile_and_run, ['-package ghc']) test('T9015', extra_run_opts('"' + config.libdir + '"'), @@ -26,7 +26,7 @@ test('T18181', compile_and_run, ['-package ghc']) test('T18522-dbg-ppr', - [extra_run_opts('"' + config.libdir + '"'), js_broken(22362)], + [extra_run_opts('"' + config.libdir + '"')], compile_and_run, ['-package ghc']) test('T19156', [ extra_run_opts('"' + config.libdir + '"') View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3505c412dd8f5ff5238d5b3a8087b82171b0cbc6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3505c412dd8f5ff5238d5b3a8087b82171b0cbc6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 09:42:19 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 02 Feb 2023 04:42:19 -0500 Subject: [Git][ghc/ghc][wip/T22761] 5 commits: Remove tracing OPTIONS_GHC Message-ID: <63db857bdacdc_2a4fc0778d81629364@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22761 at Glasgow Haskell Compiler / GHC Commits: 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - c406d550 by Simon Peyton Jones at 2023-02-02T09:32:15+00:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 30 changed files: - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Types/Var/Env.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/rewrite_rules.rst - libraries/base/GHC/Stats.hsc - libraries/base/tests/Concurrent/all.T - libraries/base/tests/IO/T12010/test.T - libraries/base/tests/all.T - libraries/hpc - libraries/stm - testsuite/tests/ado/all.T - testsuite/tests/cabal/t22333/all.T - testsuite/tests/driver/T14075/all.T - testsuite/tests/driver/all.T - testsuite/tests/driver/fat-iface/T22405/all.T - testsuite/tests/driver/j-space/all.T - testsuite/tests/driver/t22391/all.T - testsuite/tests/lib/integer/all.T - testsuite/tests/numeric/should_run/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/957715142d8b600894b9d1f4c7a1a042f790165e...c406d550864c314c381fdd1f2c6ab9894dc4e37c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/957715142d8b600894b9d1f4c7a1a042f790165e...c406d550864c314c381fdd1f2c6ab9894dc4e37c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 09:58:27 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Thu, 02 Feb 2023 04:58:27 -0500 Subject: [Git][ghc/ghc][wip/9.2.6-backports] 19 commits: Truncate eventlog event for large payload (#20221) Message-ID: <63db894350a68_1108fe526708845f@gitlab.mail> Zubin pushed to branch wip/9.2.6-backports at Glasgow Haskell Compiler / GHC Commits: e7d1f895 by Ian-Woo Kim at 2023-02-02T15:15:38+05:30 Truncate eventlog event for large payload (#20221) RTS eventlog events for postCapsetVecEvent are truncated if payload is larger than EVENT_PAYLOAD_SIZE_MAX Previously, postCapsetVecEvent records eventlog event with payload of variable size larger than EVENT_PAYLOAD_SIZE_MAX (2^16) without any validation, resulting in corrupted data. For example, this happens when a Haskell binary is invoked with very long command line arguments exceeding 2^16 bytes (see #20221). Now we check the size of accumulated payload messages incrementally, and truncate the message just before the payload size exceeds EVENT_PAYLOAD_SIZE_MAX. RTS will warn the user with a message showing how many arguments are truncated. (cherry picked from commit 2057c77d08cb8422857d182a3691f98dccd0c7d6) - - - - - 4bca98ab by Simon Peyton Jones at 2023-02-02T15:15:38+05:30 Make FloatIn robust to shadowing This MR fixes #22622. See the new Note [Shadowing and name capture] I did a bit of refactoring in sepBindsByDropPoint too. The bug doesn't manifest in HEAD, but it did show up in 9.4, so we should backport this patch to 9.4 (cherry picked from commit 6206cb9287f3f6e70c669660a646a65274870d2b) - - - - - 92cd46ec by Ben Gamari at 2023-02-02T15:15:38+05:30 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. (cherry picked from commit f891a442046d8a5ebf4d4777847880ce06752b18) - - - - - b67f5507 by Ben Gamari at 2023-02-02T15:15:38+05:30 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. (cherry picked from commit b13c6ea5d4b64841164f8cc58d6c6f3de390f2ed) - - - - - 3aae20f7 by Oleg Grenrus at 2023-02-02T15:15:38+05:30 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general (cherry picked from commit 1b812b6973a25cb1962e2fc543d2c4ed3cf31f3c) - - - - - 3be50ade by Zubin Duggal at 2023-02-02T15:15:38+05:30 Document #22255 and #22468 in bugs.rst - - - - - 5c5efe51 by Simon Peyton Jones at 2023-02-02T15:15:38+05:30 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 (cherry picked from commit 3d55d8ab51ece43c51055c43c9e7aba77cce46c0) - - - - - 9d04ca93 by Simon Peyton Jones at 2023-02-02T15:15:38+05:30 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. (cherry picked from commit e193e53790dd5886feea3cf4c9c17625d188291b) - - - - - 18de5312 by Sebastian Graf at 2023-02-02T15:15:38+05:30 DmdAnal: Don't panic in addCaseBndrDmd (#22039) Rather conservatively return Top. See Note [Untyped demand on case-alternative binders]. I also factored `addCaseBndrDmd` into two separate functions `scrutSubDmd` and `fieldBndrDmds`. Fixes #22039. (cherry picked from commit d2be80fd9b222963e8dd09a30f78c106e00da7f9) - - - - - 238359d2 by Matthew Pickering at 2023-02-02T15:15:38+05:30 ApplicativeDo: Set pattern location before running exhaustiveness checker This improves the error messages of the exhaustiveness checker when checking statements which have been moved around with ApplicativeDo. Before: Test.hs:2:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 2 | let x = () | ^^^^^^^^^^ After: Test.hs:4:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 4 | ~(Just res1) <- seq x (pure $ Nothing @()) | Fixes #22483 (cherry picked from commit 74c767df770766d8d52e87b9ff7da10f94620a91) (cherry picked from commit 51c6051bcc405bc1dbddd450ade949acd70db6b8) - - - - - ddffa513 by Andreas Klebinger at 2023-02-02T15:15:38+05:30 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- (cherry picked from commit 08ba87200ff068aa37cac082e61ee7e2d534daf5) - - - - - 0d71458a by Matthew Pickering at 2023-02-02T15:17:18+05:30 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s (cherry picked from commit a960ca817d6ad0109ea6edda50da3902cc538e86) - - - - - 24241479 by Matthew Pickering at 2023-02-02T15:17:58+05:30 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. (cherry picked from commit 734847108420cf826a807c30ad54651659cf3a08) - - - - - 8eb0c82a by Matthew Pickering at 2023-02-02T15:19:10+05:30 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes (cherry picked from commit 8c0ea25fb4a27d4729aabf73f4c00b912bb0c58d) - - - - - c4f19cf4 by Cheng Shao at 2023-02-02T15:21:24+05:30 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. (cherry picked from commit c45a5fffef2c76efbf5d3a009c3f6d0244a63f0d) - - - - - 1ced4e4a by Ben Gamari at 2023-02-02T15:22:39+05:30 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. (cherry picked from commit be417a47c7695998dea0adc05489a7b8838a78b6) - - - - - 7a6d383b by Ben Gamari at 2023-02-02T15:23:49+05:30 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. (cherry picked from commit 30989d137b8f3a8fddbfd116e04b48f23c24f86c) - - - - - b38394ce by Ben Gamari at 2023-02-02T15:24:10+05:30 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. (cherry picked from commit 7566fd9de38c67360c090f828923d41587af519c) - - - - - 1cce5944 by Ben Gamari at 2023-02-02T15:24:44+05:30 testsuite: Add regression test for #22798 (cherry picked from commit 2cb500a5ee1a31dfe1a2cdd71f175442026eb082) - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/HsToCore/Expr.hs - compiler/cbits/keepCAFsForGHCi.c - configure.ac - docs/users_guide/bugs.rst - libraries/ghc-bignum/gmp/gmp-tarballs - + m4/fp_ld_no_fixup_chains.m4 - rts/eventlog/EventLog.c - + testsuite/tests/ado/T22483.hs - + testsuite/tests/ado/T22483.stderr - testsuite/tests/ado/all.T - + testsuite/tests/codeGen/should_run/T22798.hs - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/ghci/T16392/T16392.script - testsuite/tests/ghci/linking/dyn/Makefile - testsuite/tests/rts/T18623/all.T - + testsuite/tests/safeHaskell/warnings/Makefile - + testsuite/tests/safeHaskell/warnings/T22728.hs - + testsuite/tests/safeHaskell/warnings/T22728.stderr - + testsuite/tests/safeHaskell/warnings/T22728_B.hs - + testsuite/tests/safeHaskell/warnings/T22728b.hs - + testsuite/tests/safeHaskell/warnings/T22728b.stderr - + testsuite/tests/safeHaskell/warnings/T22728b_B.hs - + testsuite/tests/safeHaskell/warnings/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e311168e37f5196614d04709b6e48f9a7f3c83d4...1cce5944838dbf00f51ad89bbace2d574c187a74 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e311168e37f5196614d04709b6e48f9a7f3c83d4...1cce5944838dbf00f51ad89bbace2d574c187a74 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 10:26:16 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 02 Feb 2023 05:26:16 -0500 Subject: [Git][ghc/ghc][wip/T22761] Refactor the simplifier a bit to fix #22761 Message-ID: <63db8fc83bdcd_1108fe526341138ab@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22761 at Glasgow Haskell Compiler / GHC Commits: 3bc3f9ca by Simon Peyton Jones at 2023-02-02T10:26:49+00:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 12 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Types/Id.hs - + testsuite/tests/simplCore/should_compile/T22761.hs - + testsuite/tests/simplCore/should_compile/T22761a.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -1300,16 +1300,19 @@ data Unfolding df_args :: [CoreExpr] -- Args of the data con: types, superclasses and methods, } -- in positional order - | CoreUnfolding { -- An unfolding for an Id with no pragma, - -- or perhaps a NOINLINE pragma - -- (For NOINLINE, the phase, if any, is in the - -- InlinePragInfo for this Id.) - uf_tmpl :: CoreExpr, -- Template; occurrence info is correct - uf_src :: UnfoldingSource, -- Where the unfolding came from - uf_is_top :: Bool, -- True <=> top level binding - uf_cache :: UnfoldingCache, -- Cache of flags computable from the expr - -- See Note [Tying the 'CoreUnfolding' knot] - uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template. + | CoreUnfolding { -- An unfolding for an Id with no pragma, + -- or perhaps a NOINLINE pragma + -- (For NOINLINE, the phase, if any, is in the + -- InlinePragInfo for this Id.) + uf_tmpl :: CoreExpr, -- The unfolding itself (aka "template") + -- Always occ-analysed; + -- See Note [OccInfo in unfoldings and rules] + + uf_src :: UnfoldingSource, -- Where the unfolding came from + uf_is_top :: Bool, -- True <=> top level binding + uf_cache :: UnfoldingCache, -- Cache of flags computable from the expr + -- See Note [Tying the 'CoreUnfolding' knot] + uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template. } -- ^ An unfolding with redundant cached information. Parameters: -- @@ -1637,14 +1640,28 @@ change was requested by Roman, but it seems to make sense. Note [OccInfo in unfoldings and rules] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In unfoldings and rules, we guarantee that the template is occ-analysed, -so that the occurrence info on the binders is correct. This is important, -because the Simplifier does not re-analyse the template when using it. If -the occurrence info is wrong - - We may get more simplifier iterations than necessary, because - once-occ info isn't there - - More seriously, we may get an infinite loop if there's a Rec - without a loop breaker marked +In unfoldings and rules, we guarantee that the template is occ-analysed, so +that the occurrence info on the binders is correct. That way, when the +Simplifier inlines an unfolding, it doesn't need to occ-analysis it first. +(The Simplifier is designed to simplify occ-analysed expressions.) + +Given this decision it's vital that we do *always* do it. + +* We may get more simplifier iterations than necessary, because once-occ + info isn't there + +* More seriously, we may get an infinite loop if there's a Rec without a + loop breaker marked + +* Or we may get code that mentions variables not in scope: #22761. + +* Another example is #8892: + \x -> letrec { f = ...g...; g* = f } in body + where g* is (for some strange reason) the loop breaker. If we don't + occ-anal it when reading it in, we won't mark g as a loop breaker, and we + may inline g entirely in body, dropping its binding, and leaving the + occurrence in f out of scope. This happened in #8892, where the unfolding + in question was a DFun unfolding. ************************************************************************ ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -3088,8 +3088,14 @@ etaExpandToJoinPointRule join_arity rule@(Rule { ru_bndrs = bndrs, ru_rhs = rhs | need_args < 0 = pprPanic "etaExpandToJoinPointRule" (ppr join_arity $$ ppr rule) | otherwise - = rule { ru_bndrs = bndrs ++ new_bndrs, ru_args = args ++ new_args - , ru_rhs = new_rhs } + = rule { ru_bndrs = bndrs ++ new_bndrs + , ru_args = args ++ new_args + , ru_rhs = new_rhs } + -- new_rhs really ought to be occ-analysed (see GHC.Core + -- Note [OccInfo in unfoldings and rules]), but it makes + -- a module loop to do so; it doesn't happen often; and it + -- doesn't really matter if the outer binders have bogus + -- occurrence info where need_args = join_arity - length args (new_bndrs, new_rhs) = etaBodyForJoinPoint need_args rhs ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -2165,6 +2165,17 @@ So we have a fast-path that keeps the old tree if the occ_bs_env is empty. This just saves a bit of allocation and reconstruction; not a big deal. +This fast path exposes a tricky cornder, though (#22761). Supose we have + Unfolding = \x. let y = foo in x+1 +which includes a dead binding for `y`. In occAnalUnfolding we occ-anal +the unfolding and produce /no/ occurrences of `foo` (since `y` is +dead). But if we discard the occ-analysed syntax tree (which we do on +our fast path), and use the old one, we still /have/ an occurrence of +`foo` -- and that can lead to out-of-scope variables (#22761). + +Solution: always keep occ-analysed trees in unfoldings and rules, so they +have no dead code. See Note [OccInfo in unfoldings and rules] in GHC.Core. + Note [Cascading inlines] ~~~~~~~~~~~~~~~~~~~~~~~~ By default we use an rhsCtxt for the RHS of a binding. This tells the ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -1068,7 +1068,7 @@ subst_id_bndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) -- See Note [Bangs in the Simplifier] !id1 = uniqAway in_scope old_id !id2 = substIdType env id1 - !id3 = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding + !id3 = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding -- and fragile OccInfo !new_id = adjust_type id3 ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -319,14 +319,14 @@ simplLazyBind :: SimplEnv -> TopLevelFlag -> RecFlag -> InId -> OutId -- Binder, both pre-and post simpl -- Not a JoinId - -- The OutId has IdInfo, except arity, unfolding + -- The OutId has IdInfo (notably RULES), + -- except arity, unfolding -- Ids only, no TyVars -> InExpr -> SimplEnv -- The RHS and its environment -> SimplM (SimplFloats, SimplEnv) -- Precondition: the OutId is already in the InScopeSet of the incoming 'env' -- Precondition: not a JoinId -- Precondition: rhs obeys the let-can-float invariant --- NOT used for JoinIds simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se = assert (isId bndr ) assertPpr (not (isJoinId bndr)) (ppr bndr) $ @@ -398,48 +398,45 @@ simplJoinBind env is_rec cont old_bndr new_bndr rhs rhs_se ; completeBind env (BC_Join is_rec cont) old_bndr new_bndr rhs' } -------------------------- -simplNonRecX :: SimplEnv +simplAuxBind :: SimplEnv -> InId -- Old binder; not a JoinId -> OutExpr -- Simplified RHS -> SimplM (SimplFloats, SimplEnv) --- A specialised variant of simplNonRec used when the RHS is already --- simplified, notably in knownCon. It uses case-binding where necessary. +-- A specialised variant of completeBindX used to construct non-recursive +-- auxiliary bindings, notably in knownCon. +-- +-- The binder comes from a case expression (case binder or alternative) +-- and so does not have rules, inline pragmas etc. -- -- Precondition: rhs satisfies the let-can-float invariant -simplNonRecX env bndr new_rhs - | assertPpr (not (isJoinId bndr)) (ppr bndr) $ +simplAuxBind env bndr new_rhs + | assertPpr (isId bndr && not (isJoinId bndr)) (ppr bndr) $ isDeadBinder bndr -- Not uncommon; e.g. case (a,b) of c { (p,q) -> p } = return (emptyFloats env, env) -- Here c is dead, and we avoid - -- creating the binding c = (a,b) - - | Coercion co <- new_rhs - = return (emptyFloats env, extendCvSubst env bndr co) + -- creating the binding c = (a,b) + -- The cases would be inlined unconditionally by completeBind: + -- but it seems not uncommon, and avoids faff to do it here + -- This is safe because it's only used for auxiliary bindings, which + -- have no NOLINE pragmas, nor RULEs | exprIsTrivial new_rhs -- Short-cut for let x = y in ... - -- This case would ultimately land in postInlineUnconditionally - -- but it seems not uncommon, and avoids a lot of faff to do it here - = return (emptyFloats env - , extendIdSubst env bndr (DoneEx new_rhs Nothing)) + = return ( emptyFloats env + , case new_rhs of + Coercion co -> extendCvSubst env bndr co + _ -> extendIdSubst env bndr (DoneEx new_rhs Nothing) ) | otherwise - = do { (env1, new_bndr) <- simplBinder env bndr - ; let is_strict = isStrictId new_bndr - -- isStrictId: use new_bndr because the InId bndr might not have - -- a fixed runtime representation, which isStrictId doesn't expect - -- c.f. Note [Dark corner with representation polymorphism] - - ; (rhs_floats, rhs1) <- prepareBinding env NotTopLevel NonRecursive is_strict - new_bndr (emptyFloats env) new_rhs - -- NB: it makes a surprisingly big difference (5% in compiler allocation - -- in T9630) to pass 'env' rather than 'env1'. It's fine to pass 'env', - -- because this is simplNonRecX, so bndr is not in scope in the RHS. - - ; (bind_float, env2) <- completeBind (env1 `setInScopeFromF` rhs_floats) - (BC_Let NotTopLevel NonRecursive) + = do { -- ANF-ise the RHS + let !occ_fs = getOccFS bndr + ; (anf_floats, rhs1) <- prepareRhs env NotTopLevel occ_fs new_rhs + ; unless (isEmptyLetFloats anf_floats) (tick LetFloatFromLet) + ; let rhs_floats = emptyFloats env `addLetFloats` anf_floats + + -- Simplify the binder and complete the binding + ; (env1, new_bndr) <- simplBinder (env `setInScopeFromF` rhs_floats) bndr + ; (bind_float, env2) <- completeBind env1 (BC_Let NotTopLevel NonRecursive) bndr new_bndr rhs1 - -- Must pass env1 to completeBind in case simplBinder had to clone, - -- and extended the substitution with [bndr :-> new_bndr] ; return (rhs_floats `addFloats` bind_float, env2) } @@ -761,49 +758,54 @@ prepareRhs :: HasDebugCallStack -- x = Just a -- See Note [prepareRhs] prepareRhs env top_lvl occ rhs0 - = do { (_is_exp, floats, rhs1) <- go 0 rhs0 - ; return (floats, rhs1) } + | is_expandable = anfise rhs0 + | otherwise = return (emptyLetFloats, rhs0) where - go :: Int -> OutExpr -> SimplM (Bool, LetFloats, OutExpr) - go n_val_args (Cast rhs co) - = do { (is_exp, floats, rhs') <- go n_val_args rhs - ; return (is_exp, floats, Cast rhs' co) } - go n_val_args (App fun (Type ty)) - = do { (is_exp, floats, rhs') <- go n_val_args fun - ; return (is_exp, floats, App rhs' (Type ty)) } - go n_val_args (App fun arg) - = do { (is_exp, floats1, fun') <- go (n_val_args+1) fun - ; if is_exp - then do { (floats2, arg') <- makeTrivial env top_lvl topDmd occ arg - ; return (True, floats1 `addLetFlts` floats2, App fun' arg') } - else return (False, emptyLetFloats, App fun arg) - } - go n_val_args (Var fun) - = return (is_exp, emptyLetFloats, Var fun) - where - is_exp = isExpandableApp fun n_val_args -- The fun a constructor or PAP - -- See Note [CONLIKE pragma] in GHC.Types.Basic - -- The definition of is_exp should match that in - -- 'GHC.Core.Opt.OccurAnal.occAnalApp' - - go n_val_args (Tick t rhs) + is_expandable = go rhs0 0 + where + go (Var fun) n_val_args = isExpandableApp fun n_val_args + -- The fun a constructor or PAP + -- See Note [CONLIKE pragma] in GHC.Types.Basic + -- The definition of is_exp should match that in + -- 'GHC.Core.Opt.OccurAnal.occAnalApp' + go (App fun arg) n_val_args + | isTypeArg arg = go fun n_val_args + | otherwise = go fun (n_val_args + 1) + go (Cast rhs _) n_val_args = go rhs n_val_args + go (Tick _ rhs) n_val_args = go rhs n_val_args + go _ _ = False + + anfise :: OutExpr -> SimplM (LetFloats, OutExpr) + anfise (Cast rhs co) + = do { (floats, rhs') <- anfise rhs + ; return (floats, Cast rhs' co) } + anfise (App fun (Type ty)) + = do { (floats, rhs') <- anfise fun + ; return (floats, App rhs' (Type ty)) } + anfise (App fun arg) + = do { (floats1, fun') <- anfise fun + ; (floats2, arg') <- makeTrivial env top_lvl topDmd occ arg + ; return (floats1 `addLetFlts` floats2, App fun' arg') } + anfise (Var fun) + = return (emptyLetFloats, Var fun) + + anfise (Tick t rhs) -- We want to be able to float bindings past this -- tick. Non-scoping ticks don't care. | tickishScoped t == NoScope - = do { (is_exp, floats, rhs') <- go n_val_args rhs - ; return (is_exp, floats, Tick t rhs') } + = do { (floats, rhs') <- anfise rhs + ; return (floats, Tick t rhs') } -- On the other hand, for scoping ticks we need to be able to -- copy them on the floats, which in turn is only allowed if -- we can obtain non-counting ticks. | (not (tickishCounts t) || tickishCanSplit t) - = do { (is_exp, floats, rhs') <- go n_val_args rhs + = do { (floats, rhs') <- anfise rhs ; let tickIt (id, expr) = (id, mkTick (mkNoCount t) expr) floats' = mapLetFloats floats tickIt - ; return (is_exp, floats', Tick t rhs') } + ; return (floats', Tick t rhs') } - go _ other - = return (False, emptyLetFloats, other) + anfise other = return (emptyLetFloats, other) makeTrivialArg :: HasDebugCallStack => SimplEnv -> ArgSpec -> SimplM (LetFloats, ArgSpec) makeTrivialArg env arg@(ValArg { as_arg = e, as_dmd = dmd }) @@ -1244,7 +1246,7 @@ simplExprF1 env (Let (NonRec bndr rhs) body) cont | otherwise = {-#SCC "simplNonRecE" #-} - simplNonRecE env False bndr (rhs, env) body cont + simplNonRecE env FromLet bndr (rhs, env) body cont {- Note [Avoiding space leaks in OutType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1505,8 +1507,9 @@ rebuild env expr cont StrictArg { sc_fun = fun, sc_cont = cont, sc_fun_ty = fun_ty } -> rebuildCall env (addValArgTo fun expr fun_ty ) cont - StrictBind { sc_bndr = b, sc_body = body, sc_env = se, sc_cont = cont } - -> completeBindX (se `setInScopeFromE` env) b expr body cont + StrictBind { sc_bndr = b, sc_body = body, sc_env = se + , sc_cont = cont, sc_from = from_what } + -> completeBindX (se `setInScopeFromE` env) from_what b expr body cont ApplyToTy { sc_arg_ty = ty, sc_cont = cont} -> rebuild env (App expr (Type ty)) cont @@ -1518,25 +1521,48 @@ rebuild env expr cont ; rebuild env (App expr arg') cont } completeBindX :: SimplEnv + -> FromWhat -> InId -> OutExpr -- Bind this Id to this (simplified) expression -- (the let-can-float invariant may not be satisfied) - -> InExpr -- In this lambda + -> InExpr -- In this body -> SimplCont -- Consumed by this continuation -> SimplM (SimplFloats, OutExpr) -completeBindX env bndr rhs body cont - | needsCaseBinding (idType bndr) rhs -- Enforcing the let-can-float-invariant - = do { (env1, bndr1) <- simplNonRecBndr env bndr - ; (floats, expr') <- simplLam env1 body cont +completeBindX env from_what bndr rhs body cont + | FromBeta arg_ty <- from_what + , needsCaseBinding arg_ty rhs -- Enforcing the let-can-float-invariant + = do { (env1, bndr1) <- simplNonRecBndr env bndr -- Lambda binders don't have rules + ; (floats, expr') <- simplNonRecBody env1 from_what body cont -- Do not float floats past the Case binder below ; let expr'' = wrapFloats floats expr' - ; let case_expr = Case rhs bndr1 (contResultType cont) [Alt DEFAULT [] expr''] + case_expr = Case rhs bndr1 (contResultType cont) [Alt DEFAULT [] expr''] ; return (emptyFloats env, case_expr) } - | otherwise - = do { (floats1, env') <- simplNonRecX env bndr rhs - ; (floats2, expr') <- simplLam env' body cont - ; return (floats1 `addFloats` floats2, expr') } + | otherwise -- Make a let-binding + = do { (env1, bndr1) <- simplNonRecBndr env bndr + ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) + + ; let is_strict = isStrictId bndr2 + -- isStrictId: use simplified binder because the InId bndr might not have + -- a fixed runtime representation, which isStrictId doesn't expect + -- c.f. Note [Dark corner with representation polymorphism] + + ; (rhs_floats, rhs1) <- prepareBinding env NotTopLevel NonRecursive is_strict + bndr2 (emptyFloats env) rhs + -- NB: it makes a surprisingly big difference (5% in compiler allocation + -- in T9630) to pass 'env' rather than 'env1'. It's fine to pass 'env', + -- because this is simplNonRecX, so bndr is not in scope in the RHS. + + ; (bind_float, env2) <- completeBind (env2 `setInScopeFromF` rhs_floats) + (BC_Let NotTopLevel NonRecursive) + bndr bndr2 rhs1 + -- Must pass env1 to completeBind in case simplBinder had to clone, + -- and extended the substitution with [bndr :-> new_bndr] + + -- Simplify the body + ; (body_floats, body') <- simplNonRecBody env2 from_what body cont + ; let all_floats = rhs_floats `addFloats` bind_float `addFloats` body_floats + ; return ( all_floats, body' ) } {- ************************************************************************ @@ -1674,6 +1700,14 @@ simplArg env dup_flag fun_ty arg_env arg ************************************************************************ -} +simplNonRecBody :: SimplEnv -> FromWhat + -> InExpr -> SimplCont + -> SimplM (SimplFloats, OutExpr) +simplNonRecBody env from_what body cont + = case from_what of + FromLet -> simplExprF env body cont + FromBeta {} -> simplLam env body cont + simplLam :: SimplEnv -> InExpr -> SimplCont -> SimplM (SimplFloats, OutExpr) @@ -1690,15 +1724,24 @@ simpl_lam env bndr body (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = cont }) -- Value beta-reduction simpl_lam env bndr body (ApplyToVal { sc_arg = arg, sc_env = arg_se - , sc_cont = cont, sc_dup = dup }) - | isSimplified dup -- Don't re-simplify if we've simplified it once - -- See Note [Avoiding exponential behaviour] + , sc_cont = cont, sc_dup = dup + , sc_hole_ty = fun_ty}) = do { tick (BetaReduction bndr) - ; completeBindX env bndr arg body cont } + ; let arg_ty = funArgTy fun_ty + ; if | isSimplified dup -- Don't re-simplify if we've simplified it once + -- Including don't preInlineUnconditionally + -- See Note [Avoiding exponential behaviour] + -> completeBindX env (FromBeta arg_ty) bndr arg body cont + + | Just env' <- preInlineUnconditionally env NotTopLevel bndr arg arg_se + , not (needsCaseBinding arg_ty arg) + -- Ok to test arg::InExpr in needsCaseBinding because + -- exprOkForSpeculation is stable under simplification + -> do { tick (PreInlineUnconditionally bndr) + ; simplLam env' body cont } - | otherwise -- See Note [Avoiding exponential behaviour] - = do { tick (BetaReduction bndr) - ; simplNonRecE env True bndr (arg, arg_se) body cont } + | otherwise + -> simplNonRecE env (FromBeta arg_ty) bndr (arg, arg_se) body cont } -- Discard a non-counting tick on a lambda. This may change the -- cost attribution slightly (moving the allocation of the @@ -1730,8 +1773,7 @@ simplLamBndrs env bndrs = mapAccumLM simplLamBndr env bndrs ------------------ simplNonRecE :: SimplEnv - -> Bool -- True <=> from a lambda - -- False <=> from a let + -> FromWhat -> InId -- The binder, always an Id -- Never a join point -> (InExpr, SimplEnv) -- Rhs of binding (or arg of lambda) @@ -1740,56 +1782,48 @@ simplNonRecE :: SimplEnv -> SimplM (SimplFloats, OutExpr) -- simplNonRecE is used for --- * non-top-level non-recursive non-join-point lets in expressions --- * beta reduction +-- * from=FromLet: a non-top-level non-recursive non-join-point let-expression +-- * from=FromBeta: a binding arising from a beta reduction -- --- simplNonRec env b (rhs, rhs_se) body k +-- simplNonRecE env b (rhs, rhs_se) body k -- = let env in -- cont< let b = rhs_se(rhs) in body > -- -- It deals with strict bindings, via the StrictBind continuation, -- which may abort the whole process. -- --- from_lam=False => the RHS satisfies the let-can-float invariant +-- from_what=FromLet => the RHS satisfies the let-can-float invariant -- Otherwise it may or may not satisfy it. -simplNonRecE env from_lam bndr (rhs, rhs_se) body cont - = assert (isId bndr && not (isJoinId bndr) ) $ - do { (env1, bndr1) <- simplNonRecBndr env bndr - ; let needs_case_binding = needsCaseBinding (idType bndr1) rhs - -- See Note [Dark corner with representation polymorphism] - -- If from_lam=False then needs_case_binding is False, - -- because the binding started as a let, which must - -- satisfy let-can-float - - ; if | from_lam && not needs_case_binding - -- If not from_lam we are coming from a (NonRec bndr rhs) binding - -- and preInlineUnconditionally has been done already; - -- no need to repeat it. But for lambdas we must be careful about - -- preInlineUndonditionally: consider (\(x:Int#). 3) (error "urk") - -- We must not drop the (error "urk"). - , Just env' <- preInlineUnconditionally env NotTopLevel bndr rhs rhs_se - -> do { tick (PreInlineUnconditionally bndr) - ; -- pprTrace "preInlineUncond" (ppr bndr <+> ppr rhs) $ - simplLam env' body cont } - - -- Deal with strict bindings - | isStrictId bndr1 && seCaseCase env - || from_lam && needs_case_binding - -- The important bit here is needs_case_binds; but no need to - -- test it if from_lam is False because then needs_case_binding is False too - -- NB: either way, the RHS may or may not satisfy let-can-float - -- but that's ok for StrictBind. - -> simplExprF (rhs_se `setInScopeFromE` env) rhs - (StrictBind { sc_bndr = bndr, sc_body = body - , sc_env = env, sc_cont = cont, sc_dup = NoDup }) - - -- Deal with lazy bindings - | otherwise - -> do { (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) - ; (floats1, env3) <- simplLazyBind env2 NotTopLevel NonRecursive bndr bndr2 rhs rhs_se - ; (floats2, expr') <- simplLam env3 body cont - ; return (floats1 `addFloats` floats2, expr') } } +simplNonRecE env from_what bndr (rhs, rhs_se) body cont + | assert (isId bndr && not (isJoinId bndr) ) $ + is_strict_bind + = -- Evaluate RHS strictly + simplExprF (rhs_se `setInScopeFromE` env) rhs + (StrictBind { sc_bndr = bndr, sc_body = body, sc_from = from_what + , sc_env = env, sc_cont = cont, sc_dup = NoDup }) + + | otherwise -- Evaluate RHS lazily + = do { (env1, bndr1) <- simplNonRecBndr env bndr + ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) + ; (floats1, env3) <- simplLazyBind env2 NotTopLevel NonRecursive + bndr bndr2 rhs rhs_se + ; (floats2, expr') <- simplNonRecBody env3 from_what body cont + ; return (floats1 `addFloats` floats2, expr') } + + where + is_strict_bind = case from_what of + FromBeta arg_ty | isUnliftedType arg_ty -> True + -- If we are coming from a beta-reduction (FromBeta) we must + -- establish the let-can-float invariant, so go via StrictBind + -- If not, the invariant holds already, and it's optional. + -- Using arg_ty: see Note [Dark corner with representation polymorphism] + -- e.g (\r \(a::TYPE r) \(x::a). blah) @LiftedRep @Int arg + -- When we come to `x=arg` we myst choose lazy/strict correctly + -- It's wrong to err in either directly + + _ -> seCaseCase env && isStrUsedDmd (idDemandInfo bndr) + ------------------ simplRecE :: SimplEnv @@ -1835,7 +1869,7 @@ Note [Avoiding exponential behaviour] One way in which we can get exponential behaviour is if we simplify a big expression, and then re-simplify it -- and then this happens in a deeply-nested way. So we must be jolly careful about re-simplifying -an expression. That is why simplNonRecX does not try +an expression (#13379). That is why simplNonRecX does not try preInlineUnconditionally (unlike simplNonRecE). Example: @@ -2618,15 +2652,10 @@ Is this inefficient? Not really: we are about to walk over the result of the rule firing to simplify it, so occurrence analysis is at most a constant factor. -Possible improvement: occ-anal the rules when putting them in the -database; and in the simplifier just occ-anal the OutExpr arguments. -But that's more complicated and the rule RHS is usually tiny; so I'm -just doing the simple thing. - -Historical note: previously we did occ-anal the rules in Rule.hs, -but failed to occ-anal the OutExpr arguments, which led to the -nasty performance problem described above. - +Note, however, that the rule RHS is /already/ occ-analysed; see +Note [OccInfo in unfoldings and rules] in GHC.Core. There is something +unsatisfactory about doing it twice; but the rule RHS is usually very +small, and this is simple. Note [Optimising tagToEnum#] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2930,7 +2959,7 @@ rebuildCase env scrut case_bndr alts cont where simple_rhs env wfloats case_bndr_rhs bs rhs = assert (null bs) $ - do { (floats1, env') <- simplNonRecX env case_bndr case_bndr_rhs + do { (floats1, env') <- simplAuxBind env case_bndr case_bndr_rhs -- scrut is a constructor application, -- hence satisfies let-can-float invariant ; (floats2, expr') <- simplExprF env' rhs cont @@ -2997,7 +3026,7 @@ rebuildCase env scrut case_bndr alts@[Alt _ bndrs rhs] cont | all_dead_bndrs , doCaseToLet scrut case_bndr = do { tick (CaseElim case_bndr) - ; (floats1, env') <- simplNonRecX env case_bndr scrut + ; (floats1, env') <- simplAuxBind env case_bndr scrut ; (floats2, expr') <- simplExprF env' rhs cont ; return (floats1 `addFloats` floats2, expr') } @@ -3483,12 +3512,11 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont bind_args env' (b:bs') (arg : args) = assert (isId b) $ do { let b' = zap_occ b - -- Note that the binder might be "dead", because it doesn't - -- occur in the RHS; and simplNonRecX may therefore discard - -- it via postInlineUnconditionally. + -- zap_occ: the binder might be "dead", because it doesn't + -- occur in the RHS; and simplAuxBind may therefore discard it. -- Nevertheless we must keep it if the case-binder is alive, -- because it may be used in the con_app. See Note [knownCon occ info] - ; (floats1, env2) <- simplNonRecX env' b' arg -- arg satisfies let-can-float invariant + ; (floats1, env2) <- simplAuxBind env' b' arg -- arg satisfies let-can-float invariant ; (floats2, env3) <- bind_args env2 bs' args ; return (floats1 `addFloats` floats2, env3) } @@ -3514,7 +3542,7 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont ; let con_app = Var (dataConWorkId dc) `mkTyApps` dc_ty_args `mkApps` dc_args - ; simplNonRecX env bndr con_app } + ; simplAuxBind env bndr con_app } ------------------- missingAlt :: SimplEnv -> Id -> [InAlt] -> SimplCont @@ -3621,15 +3649,15 @@ mkDupableContWithDmds env dmds (TickIt t cont) ; return (floats, TickIt t cont') } mkDupableContWithDmds env _ - (StrictBind { sc_bndr = bndr, sc_body = body + (StrictBind { sc_bndr = bndr, sc_body = body, sc_from = from_what , sc_env = se, sc_cont = cont}) -- See Note [Duplicating StrictBind] -- K[ let x = <> in b ] --> join j x = K[ b ] -- j <> = do { let sb_env = se `setInScopeFromE` env ; (sb_env1, bndr') <- simplBinder sb_env bndr - ; (floats1, join_inner) <- simplLam sb_env1 body cont - -- No need to use mkDupableCont before simplLam; we + ; (floats1, join_inner) <- simplNonRecBody sb_env1 from_what body cont + -- No need to use mkDupableCont before simplNonRecBody; we -- use cont once here, and then share the result if necessary ; let join_body = wrapFloats floats1 join_inner @@ -3757,6 +3785,7 @@ mkDupableStrictBind env arg_bndr join_rhs res_ty , StrictBind { sc_bndr = arg_bndr , sc_body = join_rhs , sc_env = zapSubstEnv env + , sc_from = FromLet -- See Note [StaticEnv invariant] in GHC.Core.Opt.Simplify.Utils , sc_dup = OkToDup , sc_cont = mkBoringStop res_ty } ) @@ -4430,7 +4459,9 @@ simplRules env mb_new_id rules bind_cxt ; return (rule { ru_bndrs = bndrs' , ru_fn = fn_name' , ru_args = args' - , ru_rhs = rhs' }) } + , ru_rhs = occurAnalyseExpr rhs' }) } + -- Remember to occ-analyse, to drop dead code. + -- See Note [OccInfo in unfoldings and rules] in GHC.Core {- Note [Simplifying the RHS of a RULE] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -21,7 +21,7 @@ module GHC.Core.Opt.Simplify.Utils ( BindContext(..), bindContextLevel, -- The continuation type - SimplCont(..), DupFlag(..), StaticEnv, + SimplCont(..), DupFlag(..), FromWhat(..), StaticEnv, isSimplified, contIsStop, contIsDupable, contResultType, contHoleType, contHoleScaling, contIsTrivial, contArgs, contIsRhs, @@ -192,6 +192,7 @@ data SimplCont -- or, equivalently, = K[ (\x.b) e ] { sc_dup :: DupFlag -- See Note [DupFlag invariants] , sc_bndr :: InId + , sc_from :: FromWhat , sc_body :: InExpr , sc_env :: StaticEnv -- See Note [StaticEnv invariant] , sc_cont :: SimplCont } @@ -213,6 +214,8 @@ data SimplCont type StaticEnv = SimplEnv -- Just the static part is relevant +data FromWhat = FromLet | FromBeta OutType + -- See Note [DupFlag invariants] data DupFlag = NoDup -- Unsimplified, might be big | Simplified -- Simplified ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -63,6 +63,7 @@ import GHC.Core.Tidy ( tidyRules ) import GHC.Core.Map.Expr ( eqCoreExpr ) import GHC.Core.Opt.Arity( etaExpandToJoinPointRule ) import GHC.Core.Make ( mkCoreLams ) +import GHC.Core.Opt.OccurAnal( occurAnalyseExpr ) import GHC.Tc.Utils.TcType ( tcSplitTyConApp_maybe ) import GHC.Builtin.Types ( anyTypeOfKind ) @@ -189,13 +190,18 @@ mkRule :: Module -> Bool -> Bool -> RuleName -> Activation -- ^ Used to make 'CoreRule' for an 'Id' defined in the module being -- compiled. See also 'GHC.Core.CoreRule' mkRule this_mod is_auto is_local name act fn bndrs args rhs - = Rule { ru_name = name, ru_fn = fn, ru_act = act, - ru_bndrs = bndrs, ru_args = args, - ru_rhs = rhs, - ru_rough = roughTopNames args, - ru_origin = this_mod, - ru_orphan = orph, - ru_auto = is_auto, ru_local = is_local } + = Rule { ru_name = name + , ru_act = act + , ru_fn = fn + , ru_bndrs = bndrs + , ru_args = args + , ru_rhs = occurAnalyseExpr rhs + -- See Note [OccInfo in unfoldings and rules] + , ru_rough = roughTopNames args + , ru_origin = this_mod + , ru_orphan = orph + , ru_auto = is_auto + , ru_local = is_local } where -- Compute orphanhood. See Note [Orphans] in GHC.Core.InstEnv -- A rule is an orphan only if none of the variables ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -513,8 +513,8 @@ bindNonRec bndr rhs body -- | Tests whether we have to use a @case@ rather than @let@ binding for this -- expression as per the invariants of 'CoreExpr': see "GHC.Core#let_can_float_invariant" needsCaseBinding :: Type -> CoreExpr -> Bool -needsCaseBinding ty rhs = - mightBeUnliftedType ty && not (exprOkForSpeculation rhs) +needsCaseBinding ty rhs + = mightBeUnliftedType ty && not (exprOkForSpeculation rhs) -- Make a case expression instead of a let -- These can arise either from the desugarer, -- or from beta reductions: (\x.e) (x +# y) ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -723,12 +723,14 @@ setIdCprSig id sig = modifyIdInfo (\info -> setCprSigInfo info sig) id zapIdDmdSig :: Id -> Id zapIdDmdSig id = modifyIdInfo (`setDmdSigInfo` nopSig) id --- | This predicate says whether the 'Id' has a strict demand placed on it or --- has a type such that it can always be evaluated strictly (i.e an --- unlifted type, as of GHC 7.6). We need to --- check separately whether the 'Id' has a so-called \"strict type\" because if --- the demand for the given @id@ hasn't been computed yet but @id@ has a strict --- type, we still want @isStrictId id@ to be @True at . +-- | `isStrictId` says whether either +-- (a) the 'Id' has a strict demand placed on it or +-- (b) definitely has a \"strict type\", such that it can always be +-- evaluated strictly (i.e an unlifted type) +-- We need to check (b) as well as (a), because when the demand for the +-- given `id` hasn't been computed yet but `id` has a strict +-- type, we still want `isStrictId id` to be `True`. +-- Returns False if the type is levity polymorphic; False is always safe. isStrictId :: Id -> Bool isStrictId id | assertPpr (isId id) (text "isStrictId: not an id: " <+> ppr id) $ ===================================== testsuite/tests/simplCore/should_compile/T22761.hs ===================================== @@ -0,0 +1,40 @@ +module T22761 where + +import T22761a + +newtype Mod m = Mod m deriving Num + +gcdExt :: Integer -> (Integer, Integer) +gcdExt x = go 0 x + where + go !_ 0 = (1, 1) + go r _ = go r r + +pow :: (Num m) => Mod m -> Mod m +pow x = x*x*x +{-# NOINLINE [1] pow #-} +{-# RULES +"powMod/3/Int" forall x. pow x = x*x*x +#-} + + +-- GHC puts `boo1` after `wom1` (since they don't appear connected) +-- Then { wom1 = foo True } rewrites to { wom1 = boo False } +-- so we need to do glomming. And that triggers the bug +-- in the RULE for `pow`! +-- +-- wom2/boo2 are there to still elicit the bug if +-- GHC reverses its default ordering + +{-# RULES +"wombat1" foo True = boo1 False +#-} + +wom1 = foo True +boo1 x = x + +{-# RULES +"wombat2" foo True = boo2 False +#-} +boo2 x = x +wom2 = foo True ===================================== testsuite/tests/simplCore/should_compile/T22761a.hs ===================================== @@ -0,0 +1,4 @@ +module T22761a where + +{-# NOINLINE [0] foo #-} +foo x = x ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -472,5 +472,6 @@ test('T22611', [when(wordsize(32), skip), grep_errmsg(r'\$salterF') ], compile, test('T22715_2', normal, multimod_compile, ['T22715_2', '-v0 -O -fspecialise-aggressively']) test('T22802', normal, compile, ['-O']) test('T15205', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) +test('T22761', normal, multimod_compile, ['T22761', '-O2 -v0']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3bc3f9cab9c36b27a96f340f225cc3fd8dbaa02f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3bc3f9cab9c36b27a96f340f225cc3fd8dbaa02f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 10:27:03 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Thu, 02 Feb 2023 05:27:03 -0500 Subject: [Git][ghc/ghc][wip/int-index/visibility-subsumption] 119 commits: hadrian: add hi_core flavour transformer Message-ID: <63db8ff733127_1108fe525f811468c@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/visibility-subsumption at Glasgow Haskell Compiler / GHC Commits: 1fe806d3 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add hi_core flavour transformer The hi_core flavour transformer enables -fwrite-if-simplified-core for stage1 libraries, which emit core into interface files to make it possible to restart code generation. Building boot libs with it makes it easier to use GHC API to prototype experimental backends that needs core/stg at link time. - - - - - 317cad26 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add missing docs for recently added flavour transformers - - - - - 658f4446 by Ben Gamari at 2023-01-23T04:49:23-05:00 gitlab-ci: Add Rocky8 jobs Addresses #22268. - - - - - a83ec778 by Vladislav Zavialov at 2023-01-23T04:49:58-05:00 Set "since: 9.8" for TypeAbstractions and -Wterm-variable-capture These flags did not make it into the 9.6 release series, so the "since" annotations must be corrected. - - - - - fec7c2ea by Alan Zimmerman at 2023-01-23T04:50:33-05:00 EPA: Add SourceText to HsOverLabel To be able to capture string literals with possible escape codes as labels. Close #22771 - - - - - 3efd1e99 by Ben Gamari at 2023-01-23T04:51:08-05:00 template-haskell: Bump version to 2.20.0.0 Updates `text` and `exceptions` submodules for bounds bumps. Addresses #22767. - - - - - 0900b584 by Cheng Shao at 2023-01-23T04:51:45-05:00 hadrian: disable alloca for in-tree GMP on wasm32 When building in-tree GMP for wasm32, disable its alloca usage, since it may potentially cause stack overflow (e.g. #22602). - - - - - db0f1bfd by Cheng Shao at 2023-01-23T04:52:21-05:00 Bump process submodule Includes a critical fix for wasm32, see https://github.com/haskell/process/pull/272 for details. Also changes the existing cross test to include process stuff and avoid future regression here. - - - - - 9222b167 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Fix subdir for windows bindist - - - - - 9a9bec57 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Remove viPostRemove field from generated metadata This has been removed from the downstream metadata. - - - - - 82884ce0 by Simon Peyton Jones at 2023-01-23T04:53:32-05:00 Fix #22742 runtimeRepLevity_maybe was panicing unnecessarily; and the error printing code made use of the case when it should return Nothing rather than panicing. For some bizarre reason perf/compiler/T21839r shows a 10% bump in runtime peak-megagbytes-used, on a single architecture (alpine). See !9753 for commentary, but I'm going to accept it. Metric Increase: T21839r - - - - - 2c6deb18 by Bryan Richter at 2023-01-23T14:12:22+02:00 codeowners: Add Ben, Matt, and Bryan to CI - - - - - eee3bf05 by Matthew Craven at 2023-01-23T21:46:41-05:00 Do not collect compile-time metrics for T21839r ...the testsuite doesn't handle this properly since it also collects run-time metrics. Compile-time metrics for this test are already tracked via T21839c. Metric Decrease: T21839r - - - - - 1d1dd3fb by Matthew Pickering at 2023-01-24T05:37:52-05:00 Fix recompilation checking for multiple home units The key part of this change is to store a UnitId in the `UsageHomeModule` and `UsageHomeModuleInterface`. * Fine-grained dependency tracking is used if the dependency comes from any home unit. * We actually look up the right module when checking whether we need to recompile in the `UsageHomeModuleInterface` case. These scenarios are both checked by the new tests ( multipleHomeUnits_recomp and multipleHomeUnits_recomp_th ) Fixes #22675 - - - - - 7bfb30f9 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Augment target filepath by working directory when checking if module satisfies target This fixes a spurious warning in -Wmissing-home-modules. This is a simple oversight where when looking for the target in the first place we augment the search by the -working-directory flag but then fail to do so when checking this warning. Fixes #22676 - - - - - 69500dd4 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Use NodeKey rather than ModuleName in pruneCache The `pruneCache` function assumes that the list of `CachedInfo` all have unique `ModuleName`, this is not true: * In normal compilation, the same module name can appear for a file and it's boot file. * In multiple home unit compilation the same ModuleName can appear in different units The fix is to use a `NodeKey` as the actual key for the interfaces which includes `ModuleName`, `IsBoot` and `UnitId`. Fixes #22677 - - - - - 336b2b1c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Recompilation checking: Don't try to find artefacts for Interactive & hs-boot combo In interactive mode we don't produce any linkables for hs-boot files. So we also need to not going looking for them when we check to see if we have all the right objects needed for recompilation. Ticket #22669 - - - - - 6469fea7 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Don't write o-boot files in Interactive mode We should not be producing object files when in interactive mode but we still produced the dummy o-boot files. These never made it into a `Linkable` but then confused the recompilation checker. Fixes #22669 - - - - - 06cc0a95 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Improve driver diagnostic messages by including UnitId in message Currently the driver diagnostics don't give any indication about which unit they correspond to. For example `-Wmissing-home-modules` can fire multiple times for each different home unit and gives no indication about which unit it's actually reporting about. Perhaps a longer term fix is to generalise the providence information away from a SrcSpan so that these kind of whole project errors can be reported with an accurate provenance. For now we can just include the `UnitId` in the error message. Fixes #22678 - - - - - 4fe9eaff by Matthew Pickering at 2023-01-24T05:37:52-05:00 Key ModSummary cache by UnitId as well as FilePath Multiple units can refer to the same files without any problem. Just another assumption which needs to be updated when we may have multiple home units. However, there is the invariant that within each unit each file only maps to one module, so as long as we also key the cache by UnitId then we are all good. This led to some confusing behaviour in GHCi when reloading, multipleHomeUnits_shared distils the essence of what can go wrong. Fixes #22679 - - - - - ada29f5c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Finder: Look in current unit before looking in any home package dependencies In order to preserve existing behaviour it's important to look within the current component before consideirng a module might come from an external component. This already happened by accident in `downsweep`, (because roots are used to repopulated the cache) but in the `Finder` the logic was the wrong way around. Fixes #22680 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp -------------------------p - - - - - be701cc6 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Debug: Print full NodeKey when pretty printing ModuleGraphNode This is helpful when debugging multiple component issues. - - - - - 34d2d463 by Krzysztof Gogolewski at 2023-01-24T05:38:32-05:00 Fix Lint check for duplicate external names Lint was checking for duplicate external names by calling removeDups, which needs a comparison function that is passed to Data.List.sortBy. But the comparison was not a valid ordering - it returned LT if one of the names was not external. For example, the previous implementation won't find a duplicate in [M.x, y, M.x]. Instead, we filter out non-external names before looking for duplicates. - - - - - 1c050ed2 by Matthew Pickering at 2023-01-24T05:39:08-05:00 Add test for T22671 This was fixed by b13c6ea5 Closes #22671 - - - - - 05e6a2d9 by Tom Ellis at 2023-01-24T12:10:52-05:00 Clarify where `f` is defined - - - - - d151546e by Cheng Shao at 2023-01-24T12:11:29-05:00 CmmToC: fix CmmRegOff for 64-bit register on a 32-bit target We used to print the offset value to a platform word sized integer. This is incorrect when the offset is negative (e.g. output of cmm constant folding) and the register is 64-bit but on a 32-bit target, and may lead to incorrect runtime result (e.g. #22607). The fix is simple: just treat it as a proper MO_Add, with the correct width info inferred from the register itself. Metric Increase: T12707 T13379 T4801 T5321FD T5321Fun - - - - - 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 - - - - - 1bd32a35 by Sylvain Henry at 2023-01-26T12:34:21-05:00 Factorize hptModulesBelow Create and use moduleGraphModulesBelow in GHC.Unit.Module.Graph that doesn't need anything from the driver to be used. - - - - - 1262d3f8 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Store dehydrated data structures in CgModBreaks This fixes a tricky leak in GHCi where we were retaining old copies of HscEnvs when reloading. If not all modules were recompiled then these hydrated fields in break points would retain a reference to the old HscEnv which could double memory usage. Fixes #22530 - - - - - e27eb80c by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force more in NFData Name instance Doesn't force the lazy `OccName` field (#19619) which is already known as a really bad source of leaks. When we slam the hammer storing Names on disk (in interface files or the like), all this should be forced as otherwise a `Name` can easily retain an `Id` and hence the entire world. Fixes #22833 - - - - - 3d004d5a by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force OccName in tidyTopName This occname has just been derived from an `Id`, so need to force it promptly so we can release the Id back to the world. Another symptom of the bug caused by #19619 - - - - - f2a0fea0 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Strict fields in ModNodeKey (otherwise retains HomeModInfo) Towards #22530 - - - - - 5640cb1d by Sylvain Henry at 2023-01-26T12:35:36-05:00 Hadrian: fix doc generation Was missing dependencies on files generated by templates (e.g. ghc.cabal) - - - - - 3e827c3f by Richard Eisenberg at 2023-01-26T20:06:53-05:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. - - - - - b3ef5c89 by doyougnu at 2023-01-26T20:07:48-05:00 tryFillBuffer: strictify more speculative bangs - - - - - d0d7ba0f by Vladislav Zavialov at 2023-01-26T20:08:25-05:00 base: NoImplicitPrelude in Data.Void and Data.Kind This change removes an unnecessary dependency on Prelude from two modules in the base package. - - - - - fa1db923 by Matthew Pickering at 2023-01-26T20:09:00-05: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 - - - - - 807310a1 by Matthew Pickering at 2023-01-26T20:09:00-05:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. - - - - - c7116b10 by Ben Gamari at 2023-01-26T20:09:35-05:00 base: Make changelog proposal references more consistent Addresses #22773. - - - - - 6932cfc7 by Sylvain Henry at 2023-01-26T20:10:27-05:00 Fix spurious change from !9568 - - - - - e480fbc2 by Ben Gamari at 2023-01-27T05:01:24-05:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 - - - - - 2648c09c by Andrei Borzenkov at 2023-01-27T05:02:07-05:00 Replace errors from badOrigBinding with new one (#22839) Problem: in 02279a9c the type-level [] syntax was changed from a built-in name to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if a name is not built-in then it must have come from TH quotation, but this is not necessarily the case with []. The outdated assumption in badOrigBinding leads to incorrect error messages. This code: data [] Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []" Unfortunately, there is not enough information in RdrName to directly determine if the name was constructed via TH or by the parser, so this patch changes the error message instead. It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote into a new error TcRnBindingOfExistingName and changes its wording to avoid guessing the origin of the name. - - - - - 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 67a85cc1 by Vladislav Zavialov at 2023-02-02T10:24:07+03:00 WIP: Visibility subsumption - - - - - 6c407ed5 by Vladislav Zavialov at 2023-02-02T13:26:49+03:00 WIP: Visibility check in checkTypeEq - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/hello.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - INSTALL.md - cabal.project-reinstall - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Reg.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/261a9f38cdfdf7b2a513f34ca1fc2c13032d52eb...6c407ed53842de9a179c87781cb672b49db7e134 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/261a9f38cdfdf7b2a513f34ca1fc2c13032d52eb...6c407ed53842de9a179c87781cb672b49db7e134 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 10:27:18 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Thu, 02 Feb 2023 05:27:18 -0500 Subject: [Git][ghc/ghc][wip/9.2.6-backports] hadrian: enable -haddock in perf flavour (#22734) Message-ID: <63db9006c4016_1108fe526841148a@gitlab.mail> Zubin pushed to branch wip/9.2.6-backports at Glasgow Haskell Compiler / GHC Commits: d7495c71 by Zubin Duggal at 2023-02-02T15:56:20+05:30 hadrian: enable -haddock in perf flavour (#22734) - - - - - 1 changed file: - hadrian/src/Settings/Flavours/Performance.hs Changes: ===================================== hadrian/src/Settings/Flavours/Performance.hs ===================================== @@ -13,6 +13,6 @@ performanceFlavour = defaultFlavour performanceArgs :: Args performanceArgs = sourceArgs SourceArgs { hsDefault = pure ["-O", "-H64m"] - , hsLibrary = notStage0 ? arg "-O2" + , hsLibrary = mconcat [notStage0 ? arg "-O2", notStage0 ? arg "-haddock"] , hsCompiler = pure ["-O2"] , hsGhc = mconcat [stage0 ? arg "-O", notStage0 ? arg "-O2"] } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d7495c71dc79e3c8682cf7f0b0019ba9aea66377 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d7495c71dc79e3c8682cf7f0b0019ba9aea66377 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 10:52:56 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Thu, 02 Feb 2023 05:52:56 -0500 Subject: [Git][ghc/ghc][wip/int-index/visibility-subsumption] WIP: Visibility checks in qlUnify and checkTypeEq Message-ID: <63db960879588_1108fe5260c123521@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/visibility-subsumption at Glasgow Haskell Compiler / GHC Commits: 3aadd24f by Vladislav Zavialov at 2023-02-02T13:52:32+03:00 WIP: Visibility checks in qlUnify and checkTypeEq - - - - - 10 changed files: - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/Unify.hs - testsuite/tests/typecheck/should_fail/T15079_fail_b.stderr - + testsuite/tests/typecheck/should_fail/T22648v.hs - + testsuite/tests/typecheck/should_fail/T22648v.stderr - + testsuite/tests/typecheck/should_fail/T22648v_ql.hs - + testsuite/tests/typecheck/should_fail/T22648v_ql.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -1054,7 +1054,7 @@ qlUnify delta ty1 ty2 kappa_kind = tyVarKind kappa ; co <- unifyKind (Just (TypeThing ty2)) ty2_kind kappa_kind -- unifyKind: see Note [Actual unification in qlUnify] - + ; checkSubVis ty2_kind (Check kappa_kind) ; traceTc "qlUnify:update" $ vcat [ hang (ppr kappa <+> dcolon <+> ppr kappa_kind) 2 (text ":=" <+> ppr ty2 <+> dcolon <+> ppr ty2_kind) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -34,6 +34,7 @@ module GHC.Tc.Types.Constraint ( CheckTyEqResult, CheckTyEqProblem, cteProblem, cterClearOccursCheck, cteOK, cteImpredicative, cteTypeFamily, cteInsolubleOccurs, cteSolubleOccurs, cterSetOccursCheckSoluble, + cteForallVisDiff, cterHasNoProblem, cterHasProblem, cterHasOnlyProblem, cterRemoveProblem, cterHasOccursCheck, cterFromKind, @@ -452,12 +453,13 @@ cterHasNoProblem _ = False -- | An individual problem that might be logged in a 'CheckTyEqResult' newtype CheckTyEqProblem = CTEP Word8 -cteImpredicative, cteTypeFamily, cteInsolubleOccurs, cteSolubleOccurs :: CheckTyEqProblem +cteImpredicative, cteTypeFamily, cteInsolubleOccurs, cteSolubleOccurs, cteForallVisDiff :: CheckTyEqProblem cteImpredicative = CTEP (bit 0) -- forall or (=>) encountered cteTypeFamily = CTEP (bit 1) -- type family encountered cteInsolubleOccurs = CTEP (bit 2) -- occurs-check cteSolubleOccurs = CTEP (bit 3) -- occurs-check under a type function or in a coercion -- must be one bit to the left of cteInsolubleOccurs +cteForallVisDiff = CTEP (bit 4) -- differing visibility of forall-bound variables -- See also Note [Insoluble occurs check] in GHC.Tc.Errors cteProblem :: CheckTyEqProblem -> CheckTyEqResult @@ -521,7 +523,8 @@ instance Outputable CheckTyEqResult where all_bits = [ (cteImpredicative, "cteImpredicative") , (cteTypeFamily, "cteTypeFamily") , (cteInsolubleOccurs, "cteInsolubleOccurs") - , (cteSolubleOccurs, "cteSolubleOccurs") ] + , (cteSolubleOccurs, "cteSolubleOccurs") + , (cteForallVisDiff, "cteForallVisDiff") ] set_bits = [ text str | (bitmask, str) <- all_bits , cter `cterHasProblem` bitmask ] ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -68,7 +68,7 @@ module GHC.Tc.Utils.TcMType ( -------------------------------- -- Visibility subsumption - tcSubVis, checkSubVis, + tcSubVis, tcEqVis, checkSubVis, -------------------------------- -- Zonking and tidying @@ -620,6 +620,13 @@ checkSubVis ty1 (Check ty2) = unless (tcSubVis ty1 ty2) $ addErr $ TcRnIncompatibleForallVisibility ty1 ty2 +tcEqVis :: Type -> Type -> Bool +tcEqVis ty1 ty2 = + Semi.getAll (zipForAllTyFlags eq_vis ty1 ty2) + where + eq_vis :: ForAllTyFlag -> ForAllTyFlag -> Semi.All + eq_vis flag1 flag2 = Semi.All (flag1 == flag2) + tcSubVis :: Type -- actual -> Type -- expected ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -2637,12 +2637,13 @@ checkTypeEq :: CanEqLHS -> TcType -> CheckTyEqResult -- case-analysis on 'lhs') -- * checkEqCanLHSFinish, which does not know the form of 'lhs' checkTypeEq lhs ty - = go ty + = go ty S.<> check_kind_vis (canEqLHSKind lhs) (typeKind ty) where impredicative = cteProblem cteImpredicative type_family = cteProblem cteTypeFamily insoluble_occurs = cteProblem cteInsolubleOccurs soluble_occurs = cteProblem cteSolubleOccurs + forall_vis_diff = cteProblem cteForallVisDiff -- The GHCi runtime debugger does its type-matching with -- unification variables that can unify with a polytype @@ -2722,3 +2723,8 @@ checkTypeEq lhs ty | ghci_tv = \ _tc -> cteOK | otherwise = \ tc -> (if isTauTyCon tc then cteOK else impredicative) S.<> (if isFamFreeTyCon tc then cteOK else type_family) + + check_kind_vis :: TcKind -> TcKind -> CheckTyEqResult + check_kind_vis k1 k2 + | tcEqVis k1 k2 = cteOK + | otherwise = forall_vis_diff ===================================== testsuite/tests/typecheck/should_fail/T15079_fail_b.stderr ===================================== @@ -1,8 +1,8 @@ -T15079_fail_b.hs:21:23: error: [GHC-25115] - • Visibility of forall-bound variables is not compatible - Expected: forall i. i -> * - Actual: forall {k}. k -> * +T15079_fail_b.hs:21:23: error: [GHC-83865] + • Couldn't match type ‘c0’ with ‘Coerce’ + Expected: c0 a -> Coerce b + Actual: c0 a -> c0 b • In the first argument of ‘(.)’, namely ‘hsubst f’ In the second argument of ‘(.)’, namely ‘hsubst f . Coerce’ In the expression: uncoerce . hsubst f . Coerce ===================================== testsuite/tests/typecheck/should_fail/T22648v.hs ===================================== @@ -0,0 +1,18 @@ +module T22648v where + +import Data.Kind (Type) + +type V :: forall k -> k -> Type +data V k (a :: k) = MkV + +f :: forall {k} {a :: k} (hk :: forall j. j -> Type). hk a -> () +f _ = () + +bad_tyapp :: () +bad_tyapp = f @V MkV + +bad_wild :: () +bad_wild = f @_ MkV + +bad_infer :: () +bad_infer = f MkV ===================================== testsuite/tests/typecheck/should_fail/T22648v.stderr ===================================== @@ -0,0 +1,23 @@ + +T22648v.hs:12:16: error: [GHC-25115] + • Visibility of forall-bound variables is not compatible + Expected: forall j. j -> * + Actual: forall k -> k -> * + • In the type ‘V’ + In the expression: f @V MkV + In an equation for ‘bad_tyapp’: bad_tyapp = f @V MkV + +T22648v.hs:15:15: error: [GHC-91028] + • Expected kind ‘forall j. j -> *’, but ‘_’ has kind ‘k0’ + Cannot instantiate unification variable ‘k0’ + with a kind involving polytypes: forall j. j -> * + • In the expression: f @_ MkV + In an equation for ‘bad_wild’: bad_wild = f @_ MkV + +T22648v.hs:18:15: error: [GHC-83865] + • Couldn't match type ‘hk0’ with ‘V’ + Expected: hk0 a0 + Actual: V k1 a0 + • In the first argument of ‘f’, namely ‘MkV’ + In the expression: f MkV + In an equation for ‘bad_infer’: bad_infer = f MkV ===================================== testsuite/tests/typecheck/should_fail/T22648v_ql.hs ===================================== @@ -0,0 +1,20 @@ +{-# LANGUAGE ImpredicativeTypes #-} + +module T22648v_ql where + +import Data.Kind (Type) + +type V :: forall k -> k -> Type +data V k (a :: k) = MkV + +f :: forall {k} {a :: k} (hk :: forall j. j -> Type). hk a -> () +f _ = () + +bad_tyapp :: () +bad_tyapp = f @V MkV + +bad_wild :: () +bad_wild = f @_ MkV + +bad_infer :: () +bad_infer = f MkV ===================================== testsuite/tests/typecheck/should_fail/T22648v_ql.stderr ===================================== @@ -0,0 +1,23 @@ + +T22648v_ql.hs:14:16: error: [GHC-25115] + • Visibility of forall-bound variables is not compatible + Expected: forall j. j -> * + Actual: forall k -> k -> * + • In the type ‘V’ + In the expression: f @V MkV + In an equation for ‘bad_tyapp’: bad_tyapp = f @V MkV + +T22648v_ql.hs:17:15: error: [GHC-91028] + • Expected kind ‘forall j. j -> *’, but ‘_’ has kind ‘k0’ + Cannot instantiate unification variable ‘k0’ + with a kind involving polytypes: forall j. j -> * + • In the expression: f @_ MkV + In an equation for ‘bad_wild’: bad_wild = f @_ MkV + +T22648v_ql.hs:20:15: error: [GHC-25115] + • Visibility of forall-bound variables is not compatible + Expected: forall j. j -> * + Actual: forall k -> k -> * + • In the first argument of ‘f’, namely ‘MkV’ + In the expression: f MkV + In an equation for ‘bad_infer’: bad_infer = f MkV ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -669,5 +669,7 @@ test('T20666', normal, compile_fail, ['']) test('T20666a', normal, compile_fail, ['']) test('T22648a', normal, compile_fail, ['']) test('T22648b', normal, compile_fail, ['']) +test('T22648v', normal, compile_fail, ['']) +test('T22648v_ql', normal, compile_fail, ['']) test('T15079_fail_a', normal, compile_fail, ['']) test('T15079_fail_b', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3aadd24f5d3117e901c94b334b5976e611291b7f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3aadd24f5d3117e901c94b334b5976e611291b7f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 11:35:16 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Thu, 02 Feb 2023 06:35:16 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/unboxed-codebuffer Message-ID: <63db9ff452ae_1108fe525f81358f@gitlab.mail> Josh Meredith pushed new branch wip/unboxed-codebuffer at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/unboxed-codebuffer You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 11:37:52 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Thu, 02 Feb 2023 06:37:52 -0500 Subject: [Git][ghc/ghc][wip/9.2.6-backports] Fix warnings Message-ID: <63dba09013f2_1108fe526841360b7@gitlab.mail> Zubin pushed to branch wip/9.2.6-backports at Glasgow Haskell Compiler / GHC Commits: 6282e81e by Zubin Duggal at 2023-02-02T17:06:52+05:30 Fix warnings - - - - - 1 changed file: - compiler/GHC.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -358,7 +358,6 @@ import GHC.Utils.Monad import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic -import GHC.Utils.Panic.Plain import GHC.Utils.Logger import GHC.Core.Predicate View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6282e81ee9a63452b18aa093b80824f0ae6e2b38 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6282e81ee9a63452b18aa093b80824f0ae6e2b38 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 13:19:08 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 02 Feb 2023 08:19:08 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: compiler: Implement higher order patterns in the rule matcher Message-ID: <63dbb84cddcec_1108fe526ac1513b@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - b6cbab39 by Matthew Pickering at 2023-02-02T08:19:02-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 30 changed files: - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Types/Var/Env.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/rewrite_rules.rst - libraries/base/tests/Concurrent/all.T - libraries/base/tests/IO/T12010/test.T - libraries/base/tests/all.T - libraries/hpc - libraries/stm - testsuite/tests/ado/all.T - testsuite/tests/cabal/t22333/all.T - testsuite/tests/driver/T14075/all.T - testsuite/tests/driver/all.T - testsuite/tests/driver/fat-iface/Makefile - testsuite/tests/driver/fat-iface/T22405/all.T - + testsuite/tests/driver/fat-iface/T22807.stdout - + testsuite/tests/driver/fat-iface/T22807A.hs - + testsuite/tests/driver/fat-iface/T22807B.hs - + testsuite/tests/driver/fat-iface/T22807_ghci.hs - + testsuite/tests/driver/fat-iface/T22807_ghci.script - + testsuite/tests/driver/fat-iface/T22807_ghci.stdout - testsuite/tests/driver/fat-iface/all.T - testsuite/tests/driver/j-space/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f79854f09adaafaab8c974547048a35f716acdbd...b6cbab39dc318a9c947d2d729101c7ab89dd1f78 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f79854f09adaafaab8c974547048a35f716acdbd...b6cbab39dc318a9c947d2d729101c7ab89dd1f78 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 14:34:04 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Thu, 02 Feb 2023 09:34:04 -0500 Subject: [Git][ghc/ghc][wip/andreask/infer-bytecode] 32 commits: ghc-the-library: Retain cafs in both static in dynamic builds. Message-ID: <63dbc9dce7261_1108fe52620166733@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/infer-bytecode at Glasgow Haskell Compiler / GHC Commits: 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - b8172308 by Matthew Pickering at 2023-02-01T16:08:09+01:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 88580856 by Andreas Klebinger at 2023-02-02T15:33:21+01:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - cabal.project-reinstall - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Reg.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f59e336375217d375381a44995cde0694641c14c...8858085603345386eaf633234c42753c4a6365e3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f59e336375217d375381a44995cde0694641c14c...8858085603345386eaf633234c42753c4a6365e3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 14:45:17 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Thu, 02 Feb 2023 09:45:17 -0500 Subject: [Git][ghc/ghc][wip/9.2.6-backports] Fix warnings Message-ID: <63dbcc7dbd099_1108fe526841706d5@gitlab.mail> Zubin pushed to branch wip/9.2.6-backports at Glasgow Haskell Compiler / GHC Commits: 1f212a71 by Zubin Duggal at 2023-02-02T20:14:21+05:30 Fix warnings - - - - - 2 changed files: - compiler/GHC.hs - testsuite/tests/codeGen/should_run/T22798.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -358,7 +358,6 @@ import GHC.Utils.Monad import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic -import GHC.Utils.Panic.Plain import GHC.Utils.Logger import GHC.Core.Predicate ===================================== testsuite/tests/codeGen/should_run/T22798.hs ===================================== @@ -90,7 +90,7 @@ maj :: Bits a => a -> a -> a -> a maj x y z = (x .&. (y .|. z)) .|. (y .&. z) -- note: -- the original functions is (x & y) ^ (x & z) ^ (y & z) --- if you fire off truth tables, this is equivalent to +-- if you fire off truth tables, this is equivalent to -- (x & y) | (x & z) | (y & z) -- which you can the use distribution on: -- (x & (y | z)) | (y & z) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1f212a7184c36c3149418afa1ac43173911f628b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1f212a7184c36c3149418afa1ac43173911f628b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 14:58:01 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Thu, 02 Feb 2023 09:58:01 -0500 Subject: [Git][ghc/ghc][wip/T22740] 89 commits: Hadrian: correctly detect AR at-file support Message-ID: <63dbcf79611ac_1108fe52620171933@gitlab.mail> Sylvain Henry pushed to branch wip/T22740 at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 1bd32a35 by Sylvain Henry at 2023-01-26T12:34:21-05:00 Factorize hptModulesBelow Create and use moduleGraphModulesBelow in GHC.Unit.Module.Graph that doesn't need anything from the driver to be used. - - - - - 1262d3f8 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Store dehydrated data structures in CgModBreaks This fixes a tricky leak in GHCi where we were retaining old copies of HscEnvs when reloading. If not all modules were recompiled then these hydrated fields in break points would retain a reference to the old HscEnv which could double memory usage. Fixes #22530 - - - - - e27eb80c by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force more in NFData Name instance Doesn't force the lazy `OccName` field (#19619) which is already known as a really bad source of leaks. When we slam the hammer storing Names on disk (in interface files or the like), all this should be forced as otherwise a `Name` can easily retain an `Id` and hence the entire world. Fixes #22833 - - - - - 3d004d5a by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force OccName in tidyTopName This occname has just been derived from an `Id`, so need to force it promptly so we can release the Id back to the world. Another symptom of the bug caused by #19619 - - - - - f2a0fea0 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Strict fields in ModNodeKey (otherwise retains HomeModInfo) Towards #22530 - - - - - 5640cb1d by Sylvain Henry at 2023-01-26T12:35:36-05:00 Hadrian: fix doc generation Was missing dependencies on files generated by templates (e.g. ghc.cabal) - - - - - 3e827c3f by Richard Eisenberg at 2023-01-26T20:06:53-05:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. - - - - - b3ef5c89 by doyougnu at 2023-01-26T20:07:48-05:00 tryFillBuffer: strictify more speculative bangs - - - - - d0d7ba0f by Vladislav Zavialov at 2023-01-26T20:08:25-05:00 base: NoImplicitPrelude in Data.Void and Data.Kind This change removes an unnecessary dependency on Prelude from two modules in the base package. - - - - - fa1db923 by Matthew Pickering at 2023-01-26T20:09:00-05: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 - - - - - 807310a1 by Matthew Pickering at 2023-01-26T20:09:00-05:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. - - - - - c7116b10 by Ben Gamari at 2023-01-26T20:09:35-05:00 base: Make changelog proposal references more consistent Addresses #22773. - - - - - 6932cfc7 by Sylvain Henry at 2023-01-26T20:10:27-05:00 Fix spurious change from !9568 - - - - - e480fbc2 by Ben Gamari at 2023-01-27T05:01:24-05:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 - - - - - 2648c09c by Andrei Borzenkov at 2023-01-27T05:02:07-05:00 Replace errors from badOrigBinding with new one (#22839) Problem: in 02279a9c the type-level [] syntax was changed from a built-in name to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if a name is not built-in then it must have come from TH quotation, but this is not necessarily the case with []. The outdated assumption in badOrigBinding leads to incorrect error messages. This code: data [] Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []" Unfortunately, there is not enough information in RdrName to directly determine if the name was constructed via TH or by the parser, so this patch changes the error message instead. It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote into a new error TcRnBindingOfExistingName and changes its wording to avoid guessing the origin of the name. - - - - - 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 23d860c3 by Ben Gamari at 2023-02-02T15:40:24+01:00 base: arch(js) should be arch(javascript) Cabal knows not of `arch(js)` but is well aware of `arch(javascript)`. Fixes #22740. - - - - - 1447b61b by Sylvain Henry at 2023-02-02T16:01:56+01:00 More js to javascript - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - cabal.project-reinstall - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Reg.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/BlockLayout.hs - compiler/GHC/CmmToAsm/Dwarf.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f7aa202ea694ec034971afee5e14c9c7ccbbe951...1447b61b5449eeaaa6dd54330311a034c9aed9c6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f7aa202ea694ec034971afee5e14c9c7ccbbe951...1447b61b5449eeaaa6dd54330311a034c9aed9c6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 15:02:45 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Thu, 02 Feb 2023 10:02:45 -0500 Subject: [Git][ghc/ghc][wip/T22740] Even more Message-ID: <63dbd0952bae_1108fe5263417459@gitlab.mail> Sylvain Henry pushed to branch wip/T22740 at Glasgow Haskell Compiler / GHC Commits: c2775e19 by Sylvain Henry at 2023-02-02T16:07:08+01:00 Even more - - - - - 4 changed files: - testsuite/config/ghc - testsuite/driver/testlib.py - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/numeric/should_run/all.T Changes: ===================================== testsuite/config/ghc ===================================== @@ -70,12 +70,12 @@ if windows: config.other_ways += winio_ways # LLVM -if not config.unregisterised and not config.arch == "js" and config.have_llvm: +if not config.unregisterised and not config.arch == "javascript" and config.have_llvm: config.compile_ways.append('optllvm') config.run_ways.append('optllvm') # HPC -if not config.arch == "js": +if not config.arch == "javascript": config.compile_ways.append('hpc') config.run_ways.append('hpc') ===================================== testsuite/driver/testlib.py ===================================== @@ -139,12 +139,12 @@ def skip( name, opts ): # disable test on JS arch def js_skip( name, opts ): - if arch("js"): + if arch("javascript"): skip(name,opts) # expect broken for the JS backend def js_broken( bug: IssueNumber ): - if arch("js"): + if arch("javascript"): return expect_broken(bug); else: return normal; @@ -2364,7 +2364,7 @@ def normalise_errmsg(s: str) -> str: # The inplace ghc's are called ghc-stage[123] to avoid filename # collisions, so we need to normalise that to just "ghc" s = re.sub('ghc-stage[123]', 'ghc', s) - # Remove platform prefix (e.g. js-unknown-ghcjs) for cross-compiled tools + # Remove platform prefix (e.g. javascript-unknown-ghcjs) for cross-compiled tools # (ghc, ghc-pkg, unlit, etc.) s = re.sub('\\w+-\\w+-\\w+-ghc', 'ghc', s) s = re.sub('\\w+-\\w+-\\w+-unlit', 'unlit', s) ===================================== testsuite/tests/concurrent/should_run/all.T ===================================== @@ -130,7 +130,7 @@ test('conc012', test('conc013', normal, compile_and_run, ['']) test('conc014', normal, compile_and_run, ['']) test('conc015', - [ when(arch("js"), fragile(22261)) # delays are flaky with the JS backend when the system is overloaded + [ when(arch("javascript"), fragile(22261)) # delays are flaky with the JS backend when the system is overloaded ], compile_and_run, ['']) test('conc015a', normal, compile_and_run, ['']) test('conc016', [omit_ways(concurrent_ways) # see comment in conc016.hs ===================================== testsuite/tests/numeric/should_run/all.T ===================================== @@ -63,7 +63,7 @@ test('T9407', normal, compile_and_run, ['']) test('T9810', normal, compile_and_run, ['']) test('T10011', normal, compile_and_run, ['']) test('T10962', omit_ways(['ghci']), compile_and_run, ['-O2']) -test('T11702', [unless(arch("js"),extra_ways(['optasm']))], compile_and_run, ['']) +test('T11702', [unless(arch("javascript"),extra_ways(['optasm']))], compile_and_run, ['']) test('T12136', normal, compile_and_run, ['']) test('T15301', normal, compile_and_run, ['-O2']) test('T497', normal, compile_and_run, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c2775e1939a4355054bfaa4d79539026b0527605 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c2775e1939a4355054bfaa4d79539026b0527605 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 15:33:39 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 02 Feb 2023 10:33:39 -0500 Subject: [Git][ghc/ghc][wip/T22404] 11 commits: Remove tracing OPTIONS_GHC Message-ID: <63dbd7d33b68f_1108fec035f018092b@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 4ed2ddc3 by Simon Peyton Jones at 2023-02-02T15:34:27+00:00 Work in progress on #22404 Very much not ready! - - - - - 7b0f2a40 by Sebastian Graf at 2023-02-02T15:34:27+00:00 Partition into OneOccs and ManyOccs - - - - - a8302a13 by Simon Peyton Jones at 2023-02-02T15:34:27+00:00 Wibbles - - - - - ce3b4acc by Simon Peyton Jones at 2023-02-02T15:34:27+00:00 Refactor WithTailJoinDetails - - - - - aa7477d9 by Simon Peyton Jones at 2023-02-02T15:34:27+00:00 Wibbles - - - - - 1a014007 by Simon Peyton Jones at 2023-02-02T15:34:27+00:00 Wibbles - - - - - f2135beb by Simon Peyton Jones at 2023-02-02T15:34:27+00:00 Major wibbles - - - - - 30 changed files: - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Types/Unique/FM.hs - compiler/GHC/Types/Var/Env.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/rewrite_rules.rst - libraries/base/GHC/Stats.hsc - libraries/base/tests/Concurrent/all.T - libraries/base/tests/IO/T12010/test.T - libraries/base/tests/all.T - libraries/hpc - libraries/stm - testsuite/tests/ado/all.T - testsuite/tests/cabal/t22333/all.T - testsuite/tests/driver/T14075/all.T - testsuite/tests/driver/all.T - testsuite/tests/driver/fat-iface/T22405/all.T - testsuite/tests/driver/j-space/all.T - testsuite/tests/driver/t22391/all.T - testsuite/tests/lib/integer/all.T - testsuite/tests/numeric/should_run/all.T - testsuite/tests/perf/compiler/all.T - testsuite/tests/rename/should_compile/all.T - testsuite/tests/rename/should_fail/all.T - testsuite/tests/rep-poly/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e1b5fea7b573441198e4cf8193ac8963fa1dadae...f2135beb85db2d9548828e7de0d894ec566ce48c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e1b5fea7b573441198e4cf8193ac8963fa1dadae...f2135beb85db2d9548828e7de0d894ec566ce48c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 16:31:40 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 02 Feb 2023 11:31:40 -0500 Subject: [Git][ghc/ghc][wip/T22404] Wibble Message-ID: <63dbe56cbdbf9_1108fe526202019c6@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: b5a78a03 by Simon Peyton Jones at 2023-02-02T16:32:13+00:00 Wibble - - - - - 1 changed file: - compiler/GHC/Core/Opt/OccurAnal.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -2411,7 +2411,7 @@ occAnalArgs !env fun args !one_shots !(WUD arg_uds arg') = occAnal arg_env arg !(arg_env, one_shots') | isTypeArg arg = (env, one_shots) - | otherwise = addOneShots env one_shots + | otherwise = addOneShots env_args one_shots {- Applications are dealt with specially because we want @@ -2701,7 +2701,7 @@ setRhsCtxt :: OccEncl -> OccEnv -> OccEnv setRhsCtxt ctxt !env = env { occ_encl = ctxt , occ_one_shots = [] - , occ_join_points = emptyVarEnv -- See Note [OccAnal for join points] + , occ_join_points = emptyVarEnv -- See XXXNoteXXX [OccAnal for join points] } addOneShots :: OccEnv -> [OneShots] -> (OccEnv, [OneShots]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b5a78a03c56111645a4fd12383200bf78ee49002 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b5a78a03c56111645a4fd12383200bf78ee49002 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 16:37:06 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 02 Feb 2023 11:37:06 -0500 Subject: [Git][ghc/ghc][wip/T22861] Apply 1 suggestion(s) to 1 file(s) Message-ID: <63dbe6b2cb716_1108fec035f02034f9@gitlab.mail> Ben Gamari pushed to branch wip/T22861 at Glasgow Haskell Compiler / GHC Commits: e2193751 by Bryan R at 2023-02-02T16:37:04+00:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 1 changed file: - .gitlab/ci.sh Changes: ===================================== .gitlab/ci.sh ===================================== @@ -210,7 +210,7 @@ function set_toolchain_paths() { *) fail "unknown NIX_SYSTEM" ;; esac info "Building toolchain for $NIX_SYSTEM" - nix-build -v0 .gitlab/darwin/toolchain.nix --argstr system "$NIX_SYSTEM" -o toolchain.sh + nix-build --quiet .gitlab/darwin/toolchain.nix --argstr system "$NIX_SYSTEM" -o toolchain.sh cat toolchain.sh fi source toolchain.sh View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e21937517b6f95c60f041f241085ccdf31d7aae9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e21937517b6f95c60f041f241085ccdf31d7aae9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 16:39:38 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 02 Feb 2023 11:39:38 -0500 Subject: [Git][ghc/ghc][master] docs: 9.6 release notes for wasm backend Message-ID: <63dbe74af02e4_1108fec035f0211534@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 1 changed file: - docs/users_guide/9.6.1-notes.rst Changes: ===================================== docs/users_guide/9.6.1-notes.rst ===================================== @@ -90,6 +90,22 @@ Language Compiler ~~~~~~~~ +- The `WebAssembly backend + `_ + has been merged. This allows GHC to be built as a cross-compiler + that targets ``wasm32-wasi`` and compiles Haskell code to + self-contained WebAssembly modules that can be executed on a variety + of different runtimes. There are a few caveats to be aware of: + + - To use the WebAssembly backend, one would need to follow the + instructions on `ghc-wasm-meta + `_. The WebAssembly + backend is not included in the GHC release bindists for the time + being, nor is it supported by ``ghcup`` or ``stack`` yet. + - The WebAssembly backend is still under active development. It's + presented in this GHC version as a technology preview, bugs and + missing features are expected. + - The :extension:`TypeInType` is now marked as deprecated. Its meaning has been included in :extension:`PolyKinds` and :extension:`DataKinds`. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ffe770c8d8c5c42edcf1558242f39431f72b965 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ffe770c8d8c5c42edcf1558242f39431f72b965 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 16:40:07 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 02 Feb 2023 11:40:07 -0500 Subject: [Git][ghc/ghc][master] Disable unfolding sharing for interface files with core definitions Message-ID: <63dbe767e1cc9_1108fec035f021869@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 10 changed files: - compiler/GHC/CoreToIface.hs - compiler/GHC/IfaceToCore.hs - testsuite/tests/driver/fat-iface/Makefile - + testsuite/tests/driver/fat-iface/T22807.stdout - + testsuite/tests/driver/fat-iface/T22807A.hs - + testsuite/tests/driver/fat-iface/T22807B.hs - + testsuite/tests/driver/fat-iface/T22807_ghci.hs - + testsuite/tests/driver/fat-iface/T22807_ghci.script - + testsuite/tests/driver/fat-iface/T22807_ghci.stdout - testsuite/tests/driver/fat-iface/all.T Changes: ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -604,8 +604,12 @@ toIfaceTopBind b = IfLclTopBndr {} -> IfRhs (toIfaceExpr rhs) in (top_bndr, rhs') - already_has_unfolding b = - -- The identifier has an unfolding, which we are going to serialise anyway + -- The sharing behaviour is currently disabled due to #22807, and relies on + -- finished #220056 to be re-enabled. + disabledDueTo22807 = True + + already_has_unfolding b = not disabledDueTo22807 + && -- The identifier has an unfolding, which we are going to serialise anyway hasCoreUnfolding (realIdUnfolding b) -- But not a stable unfolding, we want the optimised unfoldings. && not (isStableUnfolding (realIdUnfolding b)) @@ -771,7 +775,10 @@ is that these NOINLINE'd functions now can't be profitably inlined outside of the hs-boot loop. Note [Interface File with Core: Sharing RHSs] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +IMPORTANT: This optimisation is currently disabled due to #22027, it can be + re-enabled once #220056 is implemented. In order to avoid duplicating definitions for bindings which already have unfoldings we do some minor headstands to avoid serialising the RHS of a definition if it has ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -933,7 +933,13 @@ tc_iface_bindings (IfaceRec bs) = do -- | See Note [Interface File with Core: Sharing RHSs] tc_iface_binding :: Id -> IfaceMaybeRhs -> IfL CoreExpr -tc_iface_binding i IfUseUnfoldingRhs = return (unfoldingTemplate $ realIdUnfolding i) +tc_iface_binding i IfUseUnfoldingRhs = + case maybeUnfoldingTemplate $ realIdUnfolding i of + Just e -> return e + Nothing -> pprPanic "tc_iface_binding" (vcat [text "Binding" <+> quotes (ppr i) <+> text "had an unfolding when the interface file was created" + , text "which has now gone missing, something has badly gone wrong." + , text "Unfolding:" <+> ppr (realIdUnfolding i)]) + tc_iface_binding _ (IfRhs rhs) = tcIfaceExpr rhs mk_top_id :: IfaceTopBndrInfo -> IfL Id ===================================== testsuite/tests/driver/fat-iface/Makefile ===================================== @@ -49,4 +49,11 @@ fat010: clean echo >> "THB.hs" "$(TEST_HC)" $(TEST_HC_OPTS) THC.hs -fhide-source-paths -fwrite-if-simplified-core -fprefer-byte-code +T22807: clean + "$(TEST_HC)" $(TEST_HC_OPTS) T22807A.hs -fhide-source-paths -fwrite-if-simplified-core -fbyte-code-and-object-code -fno-omit-interface-pragmas -fprefer-byte-code + "$(TEST_HC)" $(TEST_HC_OPTS) T22807B.hs -fhide-source-paths -fwrite-if-simplified-core -fprefer-byte-code -fbyte-code-and-object-code -fno-omit-interface-pragmas + +T22807_ghci: clean + "$(TEST_HC)" $(TEST_HC_OPTS) T22807_ghci.hs -fno-full-laziness -fhide-source-paths -fwrite-if-simplified-core -O2 -dynamic -v0 + "$(TEST_HC)" $(TEST_HC_OPTS) -v0 --interactive -fhide-source-paths -fno-full-laziness < T22807_ghci.script ===================================== testsuite/tests/driver/fat-iface/T22807.stdout ===================================== @@ -0,0 +1,2 @@ +[1 of 1] Compiling T22807A +[2 of 2] Compiling T22807B ===================================== testsuite/tests/driver/fat-iface/T22807A.hs ===================================== @@ -0,0 +1,6 @@ +module T22807A where + +xs :: [a] +xs = [] + + ===================================== testsuite/tests/driver/fat-iface/T22807B.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE TemplateHaskell #-} +module T22807B where +import T22807A + +$(pure xs) ===================================== testsuite/tests/driver/fat-iface/T22807_ghci.hs ===================================== @@ -0,0 +1,8 @@ +module T22807_ghci where + + +foo b = + let x = Just [1..1000] + in if b + then Left x + else Right x ===================================== testsuite/tests/driver/fat-iface/T22807_ghci.script ===================================== @@ -0,0 +1,6 @@ +:l T22807_ghci.hs + +import T22807_ghci +import Data.Either + +isLeft (foo True) ===================================== testsuite/tests/driver/fat-iface/T22807_ghci.stdout ===================================== @@ -0,0 +1 @@ +True ===================================== testsuite/tests/driver/fat-iface/all.T ===================================== @@ -15,5 +15,9 @@ test('fat013', [req_th, extra_files(['FatTH.hs', 'FatQuote.hs'])], multimod_comp # When using interpreter should not produce objects test('fat014', [req_th, extra_files(['FatTH.hs', 'FatQuote.hs']), extra_run_opts('-fno-code')], ghci_script, ['fat014.script']) test('fat015', [req_th, unless(ghc_dynamic(), skip), extra_files(['FatQuote.hs', 'FatQuote1.hs', 'FatQuote2.hs', 'FatTH1.hs', 'FatTH2.hs', 'FatTHTop.hs'])], multimod_compile, ['FatTHTop', '-fno-code -fwrite-interface']) +test('T22807', [req_th, unless(ghc_dynamic(), skip), extra_files(['T22807A.hs', 'T22807B.hs'])] + , makefile_test, ['T22807']) +test('T22807_ghci', [req_th, unless(ghc_dynamic(), skip), extra_files(['T22807_ghci.hs'])] + , makefile_test, ['T22807_ghci']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ada454703560b733fe3c920b87496ac1238c29e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ada454703560b733fe3c920b87496ac1238c29e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 17:15:41 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 02 Feb 2023 12:15:41 -0500 Subject: [Git][ghc/ghc][wip/T22686] 58 commits: Detect family instance orphans correctly Message-ID: <63dbefbdaa078_1108fe54ddcd02206a7@gitlab.mail> Ben Gamari pushed to branch wip/T22686 at Glasgow Haskell Compiler / GHC Commits: 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 3915efc7 by Ben Gamari at 2023-01-31T17:15:45-05:00 gitlab: Collect metadata about binary distributions Fixes #22686. - - - - - 08ed4bd9 by Ben Gamari at 2023-01-31T17:16:40-05:00 bindist-metadata - - - - - 77bfe10c by Ben Gamari at 2023-02-01T09:17:53-05:00 hi - - - - - 30 changed files: - .gitlab-ci.yml - + .gitlab/bindist_metadata.py - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - cabal.project-reinstall - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Reg.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/BlockLayout.hs - compiler/GHC/CmmToAsm/Dwarf.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1163681a7174cd317a3d8082f1820e5b2ecb6c82...77bfe10c72f403e539cc9fe181c5efcd63947a55 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1163681a7174cd317a3d8082f1820e5b2ecb6c82...77bfe10c72f403e539cc9fe181c5efcd63947a55 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 18:43:48 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Thu, 02 Feb 2023 13:43:48 -0500 Subject: [Git][ghc/ghc][wip/andreask/infer-bytecode] Fix some correctness issues around tag inference when targeting the bytecode generator. Message-ID: <63dc04649d024_1108fe722f55424816d@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/infer-bytecode at Glasgow Haskell Compiler / GHC Commits: 60241bfe by Andreas Klebinger at 2023-02-02T19:43:03+01:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 4 changed files: - compiler/GHC/Driver/Config/Stg/Pipeline.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Types.hs - compiler/GHC/Stg/Pipeline.hs Changes: ===================================== compiler/GHC/Driver/Config/Stg/Pipeline.hs ===================================== @@ -22,6 +22,7 @@ initStgPipelineOpts dflags for_bytecode = StgPipelineOpts , stgPipeline_pprOpts = initStgPprOpts dflags , stgPipeline_phases = getStgToDo for_bytecode dflags , stgPlatform = targetPlatform dflags + , stgPipeline_forBytecode = for_bytecode } -- | Which Stg-to-Stg passes to run. Depends on flags, ways etc. ===================================== compiler/GHC/Stg/InferTags.hs ===================================== @@ -204,6 +204,33 @@ a different StgPass! To handle this a large part of the analysis is polymorphic over the exact StgPass we are using. Which allows us to run the analysis on the output of itself. +Note [Tag inference for interpreted code] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The bytecode interpreter has a different behaviour when it comes +to the tagging of binders in certain situations than the StgToCmm code generator. + +a) Tags for let-bindings: + + When compiling a binding for a constructor like `let x = Just True` + Weither or not `x` results in x pointing depends on the backend. + For the interpreter x points to a BCO which once + evaluated returns a properly tagged pointer to the heap object. + In the Cmm backend for the same binding we would allocate the constructor right + away and x will immediately be represented by a tagged pointer. + This means for interpreted code we can not assume let bound constructors are + properly tagged. Hence we distinguish between targeting bytecode and native in + the analysis. + We make this differentiation in `mkLetSig` where we simply never assume + lets are tagged when targeting bytecode. + +b) When referencing ids from other modules the Cmm backend will try to put a + proper tag on these references through various means. When doing analysis we + usually predict these cases to improve precision of the analysis. + But to my knowledge the bytecode generator makes no such attempts so we must + not infer imported bindings as tagged. + This is handled in GHC.Stg.InferTags.Types.lookupInfo + + -} {- ********************************************************************* @@ -212,20 +239,12 @@ the output of itself. * * ********************************************************************* -} --- doCodeGen :: HscEnv -> Module -> InfoTableProvMap -> [TyCon] --- -> CollectedCCs --- -> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs --- -> HpcInfo --- -> IO (Stream IO CmmGroupSRTs CmmCgInfos) --- -- Note we produce a 'Stream' of CmmGroups, so that the --- -- backend can be run incrementally. Otherwise it generates all --- -- the C-- up front, which has a significant space cost. -inferTags :: StgPprOpts -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) -inferTags ppr_opts logger this_mod stg_binds = do - +inferTags :: StgPprOpts -> Bool -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) +inferTags ppr_opts !for_bytecode logger this_mod stg_binds = do + -- pprTraceM "inferTags for " (ppr this_mod <> text " bytecode:" <> ppr for_bytecode) -- Annotate binders with tag information. let (!stg_binds_w_tags) = {-# SCC "StgTagFields" #-} - inferTagsAnal stg_binds + inferTagsAnal for_bytecode stg_binds putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings ppr_opts stg_binds_w_tags) let export_tag_info = collectExportInfo stg_binds_w_tags @@ -254,10 +273,10 @@ type InferExtEq i = ( XLet i ~ XLet 'InferTaggedBinders , XLetNoEscape i ~ XLetNoEscape 'InferTaggedBinders , XRhsClosure i ~ XRhsClosure 'InferTaggedBinders) -inferTagsAnal :: [GenStgTopBinding 'CodeGen] -> [GenStgTopBinding 'InferTaggedBinders] -inferTagsAnal binds = +inferTagsAnal :: Bool -> [GenStgTopBinding 'CodeGen] -> [GenStgTopBinding 'InferTaggedBinders] +inferTagsAnal for_bytecode binds = -- pprTrace "Binds" (pprGenStgTopBindings shortStgPprOpts $ binds) $ - snd (mapAccumL inferTagTopBind initEnv binds) + snd (mapAccumL inferTagTopBind (initEnv for_bytecode) binds) ----------------------- inferTagTopBind :: TagEnv 'CodeGen -> GenStgTopBinding 'CodeGen @@ -420,11 +439,12 @@ inferTagBind in_env (StgNonRec bndr rhs) -- ppr bndr $$ -- ppr (isDeadEndId id) $$ -- ppr sig) - (env', StgNonRec (id, sig) rhs') + (env', StgNonRec (id, out_sig) rhs') where id = getBinderId in_env bndr - env' = extendSigEnv in_env [(id, sig)] - (sig,rhs') = inferTagRhs id in_env rhs + (in_sig,rhs') = inferTagRhs id in_env rhs + out_sig = mkLetSig in_env in_sig + env' = extendSigEnv in_env [(id, out_sig)] inferTagBind in_env (StgRec pairs) = -- pprTrace "rec" (ppr (map fst pairs) $$ ppr (in_env { te_env = out_env }, StgRec pairs')) $ @@ -443,14 +463,17 @@ inferTagBind in_env (StgRec pairs) | in_sigs == out_sigs = (te_env rhs_env, out_bndrs `zip` rhss') | otherwise = go env' out_sigs rhss' where - out_bndrs = map updateBndr in_bndrs -- TODO: Keeps in_ids alive in_bndrs = in_ids `zip` in_sigs + out_bndrs = map updateBndr in_bndrs -- TODO: Keeps in_ids alive rhs_env = extendSigEnv go_env in_bndrs (out_sigs, rhss') = unzip (zipWithEqual "inferTagBind" anaRhs in_ids go_rhss) env' = makeTagged go_env anaRhs :: Id -> GenStgRhs q -> (TagSig, GenStgRhs 'InferTaggedBinders) - anaRhs bnd rhs = inferTagRhs bnd rhs_env rhs + anaRhs bnd rhs = + let (sig_rhs,rhs') = inferTagRhs bnd rhs_env rhs + in (mkLetSig go_env sig_rhs, rhs') + updateBndr :: (Id,TagSig) -> (Id,TagSig) updateBndr (v,sig) = (setIdTagSig v sig, sig) @@ -536,6 +559,15 @@ inferTagRhs _ env _rhs@(StgRhsCon cc con cn ticks args) = --pprTrace "inferTagRhsCon" (ppr grp_ids) $ (TagSig (inferConTag env con args), StgRhsCon cc con cn ticks args) +-- Adjust let semantics to the targeted backend. +-- See Note [Tag inference for interpreted code] +mkLetSig :: TagEnv p -> TagSig -> TagSig +mkLetSig env in_sig + | for_bytecode = TagSig TagDunno + | otherwise = in_sig + where + for_bytecode = te_bytecode env + {- Note [Constructor TagSigs] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @inferConTag@ will infer the proper tag signature for a binding who's RHS is a constructor ===================================== compiler/GHC/Stg/InferTags/Types.hs ===================================== @@ -49,24 +49,30 @@ combineAltInfo ti TagTagged = ti type TagSigEnv = IdEnv TagSig data TagEnv p = TE { te_env :: TagSigEnv , te_get :: BinderP p -> Id + , te_bytecode :: !Bool } instance Outputable (TagEnv p) where - ppr te = ppr (te_env te) - + ppr te = for_txt <+> ppr (te_env te) + where + for_txt = if te_bytecode te + then text "for_bytecode" + else text "for_native" getBinderId :: TagEnv p -> BinderP p -> Id getBinderId = te_get -initEnv :: TagEnv 'CodeGen -initEnv = TE { te_env = emptyVarEnv - , te_get = \x -> x} +initEnv :: Bool -> TagEnv 'CodeGen +initEnv for_bytecode = TE { te_env = emptyVarEnv + , te_get = \x -> x + , te_bytecode = for_bytecode } -- | Simple convert env to a env of the 'InferTaggedBinders pass -- with no other changes. makeTagged :: TagEnv p -> TagEnv 'InferTaggedBinders makeTagged env = TE { te_env = te_env env - , te_get = fst } + , te_get = fst + , te_bytecode = te_bytecode env } noSig :: TagEnv p -> BinderP p -> (Id, TagSig) noSig env bndr @@ -75,14 +81,18 @@ noSig env bndr where var = getBinderId env bndr +-- | Look up a sig in the given env lookupSig :: TagEnv p -> Id -> Maybe TagSig lookupSig env fun = lookupVarEnv (te_env env) fun +-- | Look up a sig in the env or derive it from information +-- in the arg itself. lookupInfo :: TagEnv p -> StgArg -> TagInfo lookupInfo env (StgVarArg var) -- Nullary data constructors like True, False | Just dc <- isDataConWorkId_maybe var , isNullaryRepDataCon dc + , not for_bytecode = TagProper | isUnliftedType (idType var) @@ -93,6 +103,7 @@ lookupInfo env (StgVarArg var) = info | Just lf_info <- idLFInfo_maybe var + , not for_bytecode = case lf_info of -- Function, tagged (with arity) LFReEntrant {} @@ -112,6 +123,8 @@ lookupInfo env (StgVarArg var) | otherwise = TagDunno + where + for_bytecode = te_bytecode env lookupInfo _ (StgLitArg {}) = TagProper ===================================== compiler/GHC/Stg/Pipeline.hs ===================================== @@ -50,6 +50,7 @@ data StgPipelineOpts = StgPipelineOpts -- ^ Should we lint the STG at various stages of the pipeline? , stgPipeline_pprOpts :: !StgPprOpts , stgPlatform :: !Platform + , stgPipeline_forBytecode :: !Bool } newtype StgM a = StgM { _unStgM :: ReaderT Char IO a } @@ -89,7 +90,7 @@ stg2stg logger extra_vars opts this_mod binds -- annotations (which is used by code generator to compute offsets into closures) ; let binds_sorted_with_fvs = depSortWithAnnotStgPgm this_mod binds' -- See Note [Tag inference for interactive contexts] - ; inferTags (stgPipeline_pprOpts opts) logger this_mod binds_sorted_with_fvs + ; inferTags (stgPipeline_pprOpts opts) (stgPipeline_forBytecode opts) logger this_mod binds_sorted_with_fvs } where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/60241bfeb56c85d816a28a22ad6e0b8322e3573c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/60241bfeb56c85d816a28a22ad6e0b8322e3573c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 18:44:52 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Thu, 02 Feb 2023 13:44:52 -0500 Subject: [Git][ghc/ghc][wip/9.2.6-backports] 13 commits: Fix shadowing lacuna in OccurAnal Message-ID: <63dc04a42f359_1108fe722f55424917a@gitlab.mail> Zubin pushed to branch wip/9.2.6-backports at Glasgow Haskell Compiler / GHC Commits: 400f86ab by Simon Peyton Jones at 2023-02-03T00:13:00+05:30 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. (cherry picked from commit e193e53790dd5886feea3cf4c9c17625d188291b) - - - - - bc460408 by Sebastian Graf at 2023-02-03T00:13:00+05:30 DmdAnal: Don't panic in addCaseBndrDmd (#22039) Rather conservatively return Top. See Note [Untyped demand on case-alternative binders]. I also factored `addCaseBndrDmd` into two separate functions `scrutSubDmd` and `fieldBndrDmds`. Fixes #22039. (cherry picked from commit d2be80fd9b222963e8dd09a30f78c106e00da7f9) - - - - - 302649f1 by Matthew Pickering at 2023-02-03T00:13:00+05:30 ApplicativeDo: Set pattern location before running exhaustiveness checker This improves the error messages of the exhaustiveness checker when checking statements which have been moved around with ApplicativeDo. Before: Test.hs:2:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 2 | let x = () | ^^^^^^^^^^ After: Test.hs:4:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 4 | ~(Just res1) <- seq x (pure $ Nothing @()) | Fixes #22483 (cherry picked from commit 74c767df770766d8d52e87b9ff7da10f94620a91) (cherry picked from commit 51c6051bcc405bc1dbddd450ade949acd70db6b8) - - - - - 99e23ab1 by Andreas Klebinger at 2023-02-03T00:13:00+05:30 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- (cherry picked from commit 08ba87200ff068aa37cac082e61ee7e2d534daf5) - - - - - 279f67b3 by Matthew Pickering at 2023-02-03T00:13:00+05:30 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s (cherry picked from commit a960ca817d6ad0109ea6edda50da3902cc538e86) - - - - - ebc4bc25 by Matthew Pickering at 2023-02-03T00:13:00+05:30 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. (cherry picked from commit 734847108420cf826a807c30ad54651659cf3a08) - - - - - 4d5a0917 by Matthew Pickering at 2023-02-03T00:13:00+05:30 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes (cherry picked from commit 8c0ea25fb4a27d4729aabf73f4c00b912bb0c58d) - - - - - 02c1af60 by Cheng Shao at 2023-02-03T00:13:00+05:30 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. (cherry picked from commit c45a5fffef2c76efbf5d3a009c3f6d0244a63f0d) - - - - - 2aa7d46a by Ben Gamari at 2023-02-03T00:13:00+05:30 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. (cherry picked from commit be417a47c7695998dea0adc05489a7b8838a78b6) - - - - - c55f5640 by Ben Gamari at 2023-02-03T00:13:00+05:30 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. (cherry picked from commit 30989d137b8f3a8fddbfd116e04b48f23c24f86c) - - - - - 0d59b877 by Ben Gamari at 2023-02-03T00:13:00+05:30 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. (cherry picked from commit 7566fd9de38c67360c090f828923d41587af519c) - - - - - 3fd01fe2 by Ben Gamari at 2023-02-03T00:13:40+05:30 testsuite: Add regression test for #22798 (cherry picked from commit 2cb500a5ee1a31dfe1a2cdd71f175442026eb082) - - - - - 9c35e76f by Zubin Duggal at 2023-02-03T00:13:40+05:30 hadrian: enable -haddock in perf flavour (#22734) - - - - - 23 changed files: - compiler/GHC.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/HsToCore/Expr.hs - compiler/cbits/keepCAFsForGHCi.c - configure.ac - hadrian/src/Settings/Flavours/Performance.hs - + m4/fp_ld_no_fixup_chains.m4 - + testsuite/tests/ado/T22483.hs - + testsuite/tests/ado/T22483.stderr - testsuite/tests/ado/all.T - + testsuite/tests/codeGen/should_run/T22798.hs - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/ghci/T16392/T16392.script - testsuite/tests/ghci/linking/dyn/Makefile - testsuite/tests/rts/T18623/all.T - + testsuite/tests/simplCore/should_compile/T22623.hs - + testsuite/tests/simplCore/should_compile/T22623a.hs - testsuite/tests/simplCore/should_compile/all.T - + testsuite/tests/stranal/should_compile/T22039.hs - testsuite/tests/stranal/should_compile/all.T Changes: ===================================== compiler/GHC.hs ===================================== @@ -358,6 +358,7 @@ import GHC.Utils.Monad import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Utils.Panic.Plain import GHC.Utils.Logger import GHC.Core.Predicate @@ -554,7 +555,12 @@ withCleanupSession ghc = ghc `MC.finally` cleanup initGhcMonad :: GhcMonad m => Maybe FilePath -> m () initGhcMonad mb_top_dir - = do { env <- liftIO $ + = do { -- The call to c_keepCAFsForGHCi must not be optimized away. Even in non-debug builds. + -- So we can't use assertM here. + -- See Note [keepCAFsForGHCi] in keepCAFsForGHCi.c for details about why. + !keep_cafs <- liftIO $ c_keepCAFsForGHCi + ; MASSERT( keep_cafs ) + ; env <- liftIO $ do { top_dir <- findTopDir mb_top_dir ; mySettings <- initSysTools top_dir ; myLlvmConfig <- lazyInitLlvmConfig top_dir @@ -600,7 +606,6 @@ checkBrokenTablesNextToCode' logger dflags arch = platformArch platform tablesNextToCode = platformTablesNextToCode platform - -- %************************************************************************ -- %* * -- Flags & settings @@ -1931,3 +1936,5 @@ instance Exception GhcApiError mkApiErr :: DynFlags -> SDoc -> GhcApiError mkApiErr dflags msg = GhcApiError (showSDoc dflags msg) +foreign import ccall unsafe "keepCAFsForGHCi" + c_keepCAFsForGHCi :: IO Bool ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -73,6 +73,11 @@ instance Outputable RegUsage where regUsageOfInstr :: Platform -> Instr -> RegUsage regUsageOfInstr platform instr = case instr of ANN _ i -> regUsageOfInstr platform i + COMMENT{} -> usage ([], []) + PUSH_STACK_FRAME -> usage ([], []) + POP_STACK_FRAME -> usage ([], []) + DELTA{} -> usage ([], []) + -- 1. Arithmetic Instructions ------------------------------------------------ ADD dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) CMN l r -> usage (regOp l ++ regOp r, []) @@ -137,7 +142,7 @@ regUsageOfInstr platform instr = case instr of FCVTZS dst src -> usage (regOp src, regOp dst) FABS dst src -> usage (regOp src, regOp dst) - _ -> panic "regUsageOfInstr" + _ -> panic $ "regUsageOfInstr: " ++ instrCon instr where -- filtering the usage is necessary, otherwise the register @@ -203,7 +208,11 @@ callerSavedRegisters patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr patchRegsOfInstr instr env = case instr of -- 0. Meta Instructions - ANN d i -> ANN d (patchRegsOfInstr i env) + ANN d i -> ANN d (patchRegsOfInstr i env) + COMMENT{} -> instr + PUSH_STACK_FRAME -> instr + POP_STACK_FRAME -> instr + DELTA{} -> instr -- 1. Arithmetic Instructions ---------------------------------------------- ADD o1 o2 o3 -> ADD (patchOp o1) (patchOp o2) (patchOp o3) CMN o1 o2 -> CMN (patchOp o1) (patchOp o2) @@ -269,8 +278,7 @@ patchRegsOfInstr instr env = case instr of SCVTF o1 o2 -> SCVTF (patchOp o1) (patchOp o2) FCVTZS o1 o2 -> FCVTZS (patchOp o1) (patchOp o2) FABS o1 o2 -> FABS (patchOp o1) (patchOp o2) - - _ -> pprPanic "patchRegsOfInstr" (text $ show instr) + _ -> panic $ "patchRegsOfInstr: " ++ instrCon instr where patchOp :: Operand -> Operand patchOp (OpReg w r) = OpReg w (env r) @@ -326,7 +334,7 @@ patchJumpInstr instr patchF B (TBlock bid) -> B (TBlock (patchF bid)) BL (TBlock bid) ps rs -> BL (TBlock (patchF bid)) ps rs BCOND c (TBlock bid) -> BCOND c (TBlock (patchF bid)) - _ -> pprPanic "patchJumpInstr" (text $ show instr) + _ -> panic $ "patchJumpInstr: " ++ instrCon instr -- ----------------------------------------------------------------------------- -- Note [Spills and Reloads] @@ -638,10 +646,69 @@ data Instr -- Float ABSolute value | FABS Operand Operand -instance Show Instr where - show (LDR _f o1 o2) = "LDR " ++ show o1 ++ ", " ++ show o2 - show (MOV o1 o2) = "MOV " ++ show o1 ++ ", " ++ show o2 - show _ = "missing" +instrCon :: Instr -> String +instrCon i = + case i of + COMMENT{} -> "COMMENT" + MULTILINE_COMMENT{} -> "COMMENT" + ANN{} -> "ANN" + LOCATION{} -> "LOCATION" + LDATA{} -> "LDATA" + NEWBLOCK{} -> "NEWBLOCK" + DELTA{} -> "DELTA" + SXTB{} -> "SXTB" + UXTB{} -> "UXTB" + SXTH{} -> "SXTH" + UXTH{} -> "UXTH" + PUSH_STACK_FRAME{} -> "PUSH_STACK_FRAME" + POP_STACK_FRAME{} -> "POP_STACK_FRAME" + ADD{} -> "ADD" + CMN{} -> "CMN" + CMP{} -> "CMP" + MSUB{} -> "MSUB" + MUL{} -> "MUL" + NEG{} -> "NEG" + SDIV{} -> "SDIV" + SMULH{} -> "SMULH" + SMULL{} -> "SMULL" + SUB{} -> "SUB" + UDIV{} -> "UDIV" + SBFM{} -> "SBFM" + UBFM{} -> "UBFM" + SBFX{} -> "SBFX" + UBFX{} -> "UBFX" + AND{} -> "AND" + ANDS{} -> "ANDS" + ASR{} -> "ASR" + BIC{} -> "BIC" + BICS{} -> "BICS" + EON{} -> "EON" + EOR{} -> "EOR" + LSL{} -> "LSL" + LSR{} -> "LSR" + MOV{} -> "MOV" + MOVK{} -> "MOVK" + MVN{} -> "MVN" + ORN{} -> "ORN" + ORR{} -> "ORR" + ROR{} -> "ROR" + TST{} -> "TST" + STR{} -> "STR" + LDR{} -> "LDR" + STP{} -> "STP" + LDP{} -> "LDP" + CSET{} -> "CSET" + CBZ{} -> "CBZ" + CBNZ{} -> "CBNZ" + J{} -> "J" + B{} -> "B" + BL{} -> "BL" + BCOND{} -> "BCOND" + DMBSY{} -> "DMBSY" + FCVT{} -> "FCVT" + SCVTF{} -> "SCVTF" + FCVTZS{} -> "FCVTZS" + FABS{} -> "FABS" data Target = TBlock BlockId @@ -769,11 +836,11 @@ opRegUExt W64 r = OpRegExt W64 r EUXTX 0 opRegUExt W32 r = OpRegExt W32 r EUXTW 0 opRegUExt W16 r = OpRegExt W16 r EUXTH 0 opRegUExt W8 r = OpRegExt W8 r EUXTB 0 -opRegUExt w _r = pprPanic "opRegUExt" (text $ show w) +opRegUExt w _r = pprPanic "opRegUExt" (ppr w) opRegSExt :: Width -> Reg -> Operand opRegSExt W64 r = OpRegExt W64 r ESXTX 0 opRegSExt W32 r = OpRegExt W32 r ESXTW 0 opRegSExt W16 r = OpRegExt W16 r ESXTH 0 opRegSExt W8 r = OpRegExt W8 r ESXTB 0 -opRegSExt w _r = pprPanic "opRegSExt" (text $ show w) +opRegSExt w _r = pprPanic "opRegSExt" (ppr w) ===================================== compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs ===================================== @@ -115,10 +115,8 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcInteger conflicts excl ArchSPARC64 -> panic "trivColorable ArchSPARC64" ArchPPC_64 _ -> 15 ArchARM _ _ _ -> panic "trivColorable ArchARM" - -- We should be able to allocate *a lot* more in princple. - -- essentially all 32 - SP, so 31, we'd trash the link reg - -- as well as the platform and all others though. - ArchAArch64 -> 18 + -- N.B. x18 is reserved by the platform on AArch64/Darwin + ArchAArch64 -> 17 ArchAlpha -> panic "trivColorable ArchAlpha" ArchMipseb -> panic "trivColorable ArchMipseb" ArchMipsel -> panic "trivColorable ArchMipsel" ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -439,10 +439,11 @@ dmdAnal' env dmd (Case scrut case_bndr ty [Alt alt bndrs rhs]) -- whole DmdEnv !(!bndrs', !scrut_sd) | DataAlt _ <- alt - , id_dmds <- addCaseBndrDmd case_bndr_sd dmds - -- See Note [Demand on scrutinee of a product case] - = let !new_info = setBndrsDemandInfo bndrs id_dmds - !new_prod = mkProd id_dmds + -- See Note [Demand on the scrutinee of a product case] + , let !scrut_sd = scrutSubDmd case_bndr_sd dmds + , let !fld_dmds' = fieldBndrDmds scrut_sd (length dmds) + = let !new_info = setBndrsDemandInfo bndrs fld_dmds' + !new_prod = mkProd fld_dmds' in (new_info, new_prod) | otherwise -- __DEFAULT and literal alts. Simply add demands and discard the @@ -556,11 +557,32 @@ dmdAnalSumAlt env dmd case_bndr (Alt con bndrs rhs) , WithDmdType rhs_ty rhs' <- dmdAnal rhs_env dmd rhs , WithDmdType alt_ty dmds <- findBndrsDmds env rhs_ty bndrs , let (_ :* case_bndr_sd) = findIdDemand alt_ty case_bndr - -- See Note [Demand on scrutinee of a product case] - id_dmds = addCaseBndrDmd case_bndr_sd dmds + -- See Note [Demand on case-alternative binders] + -- we can't use the scrut_sd, because it says 'Prod' and we'll use + -- topSubDmd anyway for scrutinees of sum types. + scrut_sd = scrutSubDmd case_bndr_sd dmds + id_dmds = fieldBndrDmds scrut_sd (length dmds) -- Do not put a thunk into the Alt - !new_ids = setBndrsDemandInfo bndrs id_dmds - = WithDmdType alt_ty (Alt con new_ids rhs') + !new_ids = setBndrsDemandInfo bndrs id_dmds + = -- pprTrace "dmdAnalSumAlt" (ppr con $$ ppr case_bndr $$ ppr dmd $$ ppr alt_ty) $ + WithDmdType alt_ty (Alt con new_ids rhs') + +-- See Note [Demand on the scrutinee of a product case] +scrutSubDmd :: SubDemand -> [Demand] -> SubDemand +scrutSubDmd case_sd fld_dmds = + -- pprTraceWith "scrutSubDmd" (\scrut_sd -> ppr case_sd $$ ppr fld_dmds $$ ppr scrut_sd) $ + case_sd `plusSubDmd` mkProd fld_dmds + +-- See Note [Demand on case-alternative binders] +fieldBndrDmds :: SubDemand -- on the scrutinee + -> Arity + -> [Demand] -- Final demands for the components of the DataCon +fieldBndrDmds scrut_sd n_flds = + case viewProd n_flds scrut_sd of + Just ds -> ds + Nothing -> replicate n_flds topDmd + -- Either an arity mismatch or scrut_sd was a call demand. + -- See Note [Untyped demand on case-alternative binders] {- Note [Analysing with absent demand] @@ -672,6 +694,89 @@ worker, so the worker will rebuild x = (a, absent-error) and that'll crash. +Note [Demand on case-alternative binders] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The demand on a binder in a case alternative comes + (a) From the demand on the binder itself + (b) From the demand on the case binder +Forgetting (b) led directly to #10148. + +Example. Source code: + f x@(p,_) = if p then foo x else True + + foo (p,True) = True + foo (p,q) = foo (q,p) + +After strictness analysis, forgetting (b): + f = \ (x_an1 [Dmd=1P(1L,ML)] :: (Bool, Bool)) -> + case x_an1 + of wild_X7 [Dmd=MP(ML,ML)] + { (p_an2 [Dmd=1L], ds_dnz [Dmd=A]) -> + case p_an2 of _ { + False -> GHC.Types.True; + True -> foo wild_X7 } + +Note that ds_dnz is syntactically dead, but the expression bound to it is +reachable through the case binder wild_X7. Now watch what happens if we inline +foo's wrapper: + f = \ (x_an1 [Dmd=1P(1L,ML)] :: (Bool, Bool)) -> + case x_an1 + of _ [Dmd=MP(ML,ML)] + { (p_an2 [Dmd=1L], ds_dnz [Dmd=A]) -> + case p_an2 of _ { + False -> GHC.Types.True; + True -> $wfoo_soq GHC.Types.True ds_dnz } + +Look at that! ds_dnz has come back to life in the call to $wfoo_soq! A second +run of demand analysis would no longer infer ds_dnz to be absent. +But unlike occurrence analysis, which infers properties of the *syntactic* +shape of the program, the results of demand analysis describe expressions +*semantically* and are supposed to be mostly stable across Simplification. +That's why we should better account for (b). +In #10148, we ended up emitting a single-entry thunk instead of an updateable +thunk for a let binder that was an an absent case-alt binder during DmdAnal. + +This is needed even for non-product types, in case the case-binder +is used but the components of the case alternative are not. + +Note [Untyped demand on case-alternative binders] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +With unsafeCoerce, #8037 and #22039 taught us that the demand on the case binder +may be a call demand or have a different number of fields than the constructor +of the case alternative it is used in. From T22039: + + blarg :: (Int, Int) -> Int + blarg (x,y) = x+y + -- blarg :: <1!P(1L,1L)> + + f :: Either Int Int -> Int + f Left{} = 0 + f e = blarg (unsafeCoerce e) + ==> { desugars to } + f = \ (ds_d1nV :: Either Int Int) -> + case ds_d1nV of wild_X1 { + Left ds_d1oV -> lvl_s1Q6; + Right ipv_s1Pl -> + blarg + (case unsafeEqualityProof @(*) @(Either Int Int) @(Int, Int) of + { UnsafeRefl co_a1oT -> + wild_X1 `cast` (Sub (Sym co_a1oT) :: Either Int Int ~R# (Int, Int)) + }) + } + +The case binder `e`/`wild_X1` has demand 1!P(1L,1L), with two fields, from the call +to `blarg`, but `Right` only has one field. Although the code will crash when +executed, we must be able to analyse it in 'fieldBndrDmds' and conservatively +approximate with Top instead of panicking because of the mismatch. +In #22039, this kind of code was guarded behind a safe `cast` and thus dead +code, but nevertheless led to a panic of the compiler. + +You might wonder why the same problem doesn't come up when scrutinising a +product type instead of a sum type. It appears that for products, `wild_X1` +will be inlined before DmdAnal. + +See also Note [mkWWstr and unsafeCoerce] for a related issue. + Note [Aggregated demand for cardinality] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FIXME: This Note should be named [LetUp vs. LetDown] and probably predates ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -1725,7 +1725,7 @@ occAnalRhs :: OccEnv -> RecFlag -> Maybe JoinArity -> CoreExpr -- RHS -> (UsageDetails, CoreExpr) occAnalRhs env is_rec mb_join_arity rhs - = case occAnalLamOrRhs env bndrs body of { (body_usage, bndrs', body') -> + = case occAnalLamOrRhs env1 bndrs body of { (body_usage, bndrs', body') -> let final_bndrs | isRec is_rec = bndrs' | otherwise = markJoinOneShots mb_join_arity bndrs' -- For a /non-recursive/ join point we can mark all @@ -1737,6 +1737,7 @@ occAnalRhs env is_rec mb_join_arity rhs in (rhs_usage, mkLams final_bndrs body') } where (bndrs, body) = collectBinders rhs + env1 = addInScope env bndrs occAnalUnfolding :: OccEnv -> RecFlag @@ -2005,7 +2006,7 @@ partially applying lambdas. See the calls to zapLamBndrs in occAnal env expr@(Lam _ _) = -- See Note [Occurrence analysis for lambda binders] - case occAnalLamOrRhs env bndrs body of { (usage, tagged_bndrs, body') -> + case occAnalLamOrRhs env1 bndrs body of { (usage, tagged_bndrs, body') -> let expr' = mkLams tagged_bndrs body' usage1 = markAllNonTail usage @@ -2015,6 +2016,7 @@ occAnal env expr@(Lam _ _) (final_usage, expr') } where (bndrs, body) = collectBinders expr + env1 = addInScope env bndrs occAnal env (Case scrut bndr ty alts) = case occAnal (scrutCtxt env alts) scrut of { (scrut_usage, scrut') -> @@ -2284,12 +2286,13 @@ data OccEnv -- See Note [The binder-swap substitution] -- If x :-> (y, co) is in the env, - -- then please replace x by (y |> sym mco) - -- Invariant of course: idType x = exprType (y |> sym mco) - , occ_bs_env :: VarEnv (OutId, MCoercion) - , occ_bs_rng :: VarSet -- Vars free in the range of occ_bs_env + -- then please replace x by (y |> mco) + -- Invariant of course: idType x = exprType (y |> mco) + , occ_bs_env :: !(IdEnv (OutId, MCoercion)) -- Domain is Global and Local Ids -- Range is just Local Ids + , occ_bs_rng :: !VarSet + -- Vars (TyVars and Ids) free in the range of occ_bs_env } @@ -2578,25 +2581,29 @@ Some tricky corners: (BS3) We need care when shadowing. Suppose [x :-> b] is in occ_bs_env, and we encounter: - - \x. blah - Here we want to delete the x-binding from occ_bs_env - - - \b. blah - This is harder: we really want to delete all bindings that - have 'b' free in the range. That is a bit tiresome to implement, - so we compromise. We keep occ_bs_rng, which is the set of - free vars of rng(occc_bs_env). If a binder shadows any of these - variables, we discard all of occ_bs_env. Safe, if a bit - brutal. NB, however: the simplifer de-shadows the code, so the - next time around this won't happen. + (i) \x. blah + Here we want to delete the x-binding from occ_bs_env + + (ii) \b. blah + This is harder: we really want to delete all bindings that + have 'b' free in the range. That is a bit tiresome to implement, + so we compromise. We keep occ_bs_rng, which is the set of + free vars of rng(occc_bs_env). If a binder shadows any of these + variables, we discard all of occ_bs_env. Safe, if a bit + brutal. NB, however: the simplifer de-shadows the code, so the + next time around this won't happen. These checks are implemented in addInScope. - - The occurrence analyser itself does /not/ do cloning. It could, in - principle, but it'd make it a bit more complicated and there is no - great benefit. The simplifer uses cloning to get a no-shadowing - situation, the care-when-shadowing behaviour above isn't needed for - long. + (i) is needed only for Ids, but (ii) is needed for tyvars too (#22623) + because if occ_bs_env has [x :-> ...a...] where `a` is a tyvar, we + must not replace `x` by `...a...` under /\a. ...x..., or similarly + under a case pattern match that binds `a`. + + An alternative would be for the occurrence analyser to do cloning as + it goes. In principle it could do so, but it'd make it a bit more + complicated and there is no great benefit. The simplifer uses + cloning to get a no-shadowing situation, the care-when-shadowing + behaviour above isn't needed for long. (BS4) The domain of occ_bs_env can include GlobaIds. Eg case M.foo of b { alts } ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -984,7 +984,8 @@ dsDo ctx stmts ; body' <- dsLExpr $ noLocA $ HsDo body_ty ctx (noLocA stmts) ; let match_args (pat, fail_op) (vs,body) - = do { var <- selectSimpleMatchVarL Many pat + = putSrcSpanDs (getLocA pat) $ + do { var <- selectSimpleMatchVarL Many pat ; match <- matchSinglePatVar var Nothing (StmtCtxt ctx) pat body_ty (cantFailMatchResult body) ; match_code <- dsHandleMonadicFailure ctx pat match fail_op ===================================== compiler/cbits/keepCAFsForGHCi.c ===================================== @@ -1,15 +1,35 @@ #include +#include +// Note [keepCAFsForGHCi] +// ~~~~~~~~~~~~~~~~~~~~~~ // This file is only included in the dynamic library. // It contains an __attribute__((constructor)) function (run prior to main()) // which sets the keepCAFs flag in the RTS, before any Haskell code is run. // This is required so that GHCi can use dynamic libraries instead of HSxyz.o // files. +// +// For static builds we have to guarantee that the linker loads this object file +// to ensure the constructor gets run and not discarded. If the object is part of +// an archive and not otherwise referenced the linker would ignore the object. +// To avoid this: +// * When initializing a GHC session in initGhcMonad we assert keeping cafs has been +// enabled by calling keepCAFsForGHCi. +// * This causes the GHC module from the ghc package to carry a reference to this object +// file. +// * Which in turn ensures the linker doesn't discard this object file, causing +// the constructor to be run, allowing the assertion to succeed in the first place +// as keepCAFs will have been set already during initialization of constructors. -static void keepCAFsForGHCi(void) __attribute__((constructor)); -static void keepCAFsForGHCi(void) + +bool keepCAFsForGHCi(void) __attribute__((constructor)); + +bool keepCAFsForGHCi(void) { - keepCAFs = 1; + bool was_set = keepCAFs; + setKeepCAFs(); + return was_set; } + ===================================== configure.ac ===================================== @@ -780,6 +780,10 @@ FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE1],[CONF_GCC_LINKER_OPTS_STAG FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE2],[CONF_GCC_LINKER_OPTS_STAGE2],[CONF_LD_LINKER_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2]) # Stage 3 won't be supported by cross-compilation +FP_LD_NO_FIXUP_CHAINS([target], [LDFLAGS]) +FP_LD_NO_FIXUP_CHAINS([build], [CONF_GCC_LINKER_OPTS_STAGE0]) +FP_LD_NO_FIXUP_CHAINS([target], [CONF_GCC_LINKER_OPTS_STAGE1]) +FP_LD_NO_FIXUP_CHAINS([target], [CONF_GCC_LINKER_OPTS_STAGE2]) dnl ** See whether cc supports --target= and set dnl CONF_CC_OPTS_STAGE[12] accordingly. FP_CC_SUPPORTS_TARGET ===================================== hadrian/src/Settings/Flavours/Performance.hs ===================================== @@ -13,6 +13,6 @@ performanceFlavour = defaultFlavour performanceArgs :: Args performanceArgs = sourceArgs SourceArgs { hsDefault = pure ["-O", "-H64m"] - , hsLibrary = notStage0 ? arg "-O2" + , hsLibrary = mconcat [notStage0 ? arg "-O2", notStage0 ? arg "-haddock"] , hsCompiler = pure ["-O2"] , hsGhc = mconcat [stage0 ? arg "-O", notStage0 ? arg "-O2"] } ===================================== m4/fp_ld_no_fixup_chains.m4 ===================================== @@ -0,0 +1,24 @@ +# FP_LD_NO_FIXUP_CHAINS +# -------------------- +# See if whether we are using a version of ld64 on darwin platforms which +# requires us to pass -no_fixup_chains +# +# $1 = the platform +# $2 = the name of the linker flags variable when linking with $CC +AC_DEFUN([FP_LD_NO_FIXUP_CHAINS], [ + case $$1 in + *-darwin) + AC_MSG_CHECKING([whether ld64 requires -no_fixup_chains]) + echo 'int main(void) {return 0;}' > conftest.c + if $CC -o conftest.o -Wl,-no_fixup_chains conftest.c > /dev/null 2>&1 + then + $2="-Wl,-no_fixup_chains" + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + fi + rm -f conftest.c conftest.o + ;; + + esac +]) ===================================== testsuite/tests/ado/T22483.hs ===================================== @@ -0,0 +1,7 @@ +main = do + let x = () + res2 <- pure () + ~(Just res1) <- seq x (pure $ Nothing @()) + print res1 + print res2 + pure () ===================================== testsuite/tests/ado/T22483.stderr ===================================== @@ -0,0 +1,8 @@ + +T22483.hs:1:1: warning: [-Wmissing-signatures (in -Wall)] + Top-level binding with no type signature: main :: IO () + +T22483.hs:4:3: warning: [-Wincomplete-uni-patterns (in -Wall)] + Pattern match(es) are non-exhaustive + In a pattern binding: + Patterns of type ‘Maybe ()’ not matched: Nothing ===================================== testsuite/tests/ado/all.T ===================================== @@ -18,3 +18,4 @@ test('T14163', normal, compile_and_run, ['']) test('T15344', normal, compile_and_run, ['']) test('T16628', normal, compile_fail, ['']) test('T17835', normal, compile, ['']) +test('T22483', normal, compile, ['-Wall']) ===================================== testsuite/tests/codeGen/should_run/T22798.hs ===================================== @@ -0,0 +1,375 @@ +-- Derived from SHA-1.5.0.0 +-- This previously uncovered cases left unhandled in the AArch64 NCG (#22798). + +{-# LANGUAGE BangPatterns, CPP, FlexibleInstances #-} +module Main (main) where + +import Data.Binary +import Data.Binary.Get +import Data.Binary.Put +import Data.Bits +import Data.ByteString.Lazy(ByteString) +import Data.ByteString.Lazy.Char8 as BSC (pack) +import qualified Data.ByteString.Lazy as BS +import Data.Char (intToDigit) +import Control.Monad + +newtype Digest t = Digest ByteString + +data SHA512State = SHA512S !Word64 !Word64 !Word64 !Word64 + !Word64 !Word64 !Word64 !Word64 + +initialSHA512State :: SHA512State +initialSHA512State = SHA512S 0x6a09e667f3bcc908 0xbb67ae8584caa73b + 0x3c6ef372fe94f82b 0xa54ff53a5f1d36f1 + 0x510e527fade682d1 0x9b05688c2b3e6c1f + 0x1f83d9abfb41bd6b 0x5be0cd19137e2179 + + +synthesizeSHA512 :: SHA512State -> Put +synthesizeSHA512 (SHA512S a b c d e f g h) = do + putWord64be a + putWord64be b + putWord64be c + putWord64be d + putWord64be e + putWord64be f + putWord64be g + putWord64be h + +getSHA512 :: Get SHA512State +getSHA512 = do + a <- getWord64be + b <- getWord64be + c <- getWord64be + d <- getWord64be + e <- getWord64be + f <- getWord64be + g <- getWord64be + h <- getWord64be + return $ SHA512S a b c d e f g h + +instance Binary SHA512State where + put = synthesizeSHA512 + get = getSHA512 + +padSHA512 :: ByteString -> ByteString +padSHA512 = generic_pad 896 1024 128 + +generic_pad :: Word64 -> Word64 -> Int -> ByteString -> ByteString +generic_pad a b lSize bs = BS.concat [bs, pad_bytes, pad_length] + where + l = fromIntegral $ BS.length bs * 8 + k = calc_k a b l + -- INVARIANT: k is necessarily > 0, and (k + 1) is a multiple of 8. + k_bytes = (k + 1) `div` 8 + pad_bytes = BS.singleton 0x80 `BS.append` BS.replicate nZeroBytes 0 + nZeroBytes = fromIntegral $ k_bytes - 1 + pad_length = toBigEndianBS lSize l + +-- Given a, b, and l, calculate the smallest k such that (l + 1 + k) mod b = a. +calc_k :: Word64 -> Word64 -> Word64 -> Word64 +calc_k a b l = + if r <= -1 + then fromIntegral r + b + else fromIntegral r + where + r = toInteger a - toInteger l `mod` toInteger b - 1 + +toBigEndianBS :: (Integral a, Bits a) => Int -> a -> ByteString +toBigEndianBS s val = BS.pack $ map getBits [s - 8, s - 16 .. 0] + where + getBits x = fromIntegral $ (val `shiftR` x) .&. 0xFF + +{-# SPECIALIZE ch :: Word64 -> Word64 -> Word64 -> Word64 #-} +ch :: Bits a => a -> a -> a -> a +ch x y z = (x .&. y) `xor` (complement x .&. z) + +{-# SPECIALIZE maj :: Word64 -> Word64 -> Word64 -> Word64 #-} +maj :: Bits a => a -> a -> a -> a +maj x y z = (x .&. (y .|. z)) .|. (y .&. z) +-- note: +-- the original functions is (x & y) ^ (x & z) ^ (y & z) +-- if you fire off truth tables, this is equivalent to +-- (x & y) | (x & z) | (y & z) +-- which you can the use distribution on: +-- (x & (y | z)) | (y & z) +-- which saves us one operation. + +bsig512_0 :: Word64 -> Word64 +bsig512_0 x = rotate x (-28) `xor` rotate x (-34) `xor` rotate x (-39) + +bsig512_1 :: Word64 -> Word64 +bsig512_1 x = rotate x (-14) `xor` rotate x (-18) `xor` rotate x (-41) + +lsig512_0 :: Word64 -> Word64 +lsig512_0 x = rotate x (-1) `xor` rotate x (-8) `xor` shiftR x 7 + +lsig512_1 :: Word64 -> Word64 +lsig512_1 x = rotate x (-19) `xor` rotate x (-61) `xor` shiftR x 6 + +data SHA512Sched = SHA512Sched !Word64 !Word64 !Word64 !Word64 !Word64 -- 0- 4 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 5- 9 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 10-14 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 15-19 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 20-24 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 25-29 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 30-34 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 35-39 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 40-44 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 45-49 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 50-54 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 55-59 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 60-64 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 65-69 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 70-74 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 75-79 + +getSHA512Sched :: Get SHA512Sched +getSHA512Sched = do + w00 <- getWord64be + w01 <- getWord64be + w02 <- getWord64be + w03 <- getWord64be + w04 <- getWord64be + w05 <- getWord64be + w06 <- getWord64be + w07 <- getWord64be + w08 <- getWord64be + w09 <- getWord64be + w10 <- getWord64be + w11 <- getWord64be + w12 <- getWord64be + w13 <- getWord64be + w14 <- getWord64be + w15 <- getWord64be + let w16 = lsig512_1 w14 + w09 + lsig512_0 w01 + w00 + w17 = lsig512_1 w15 + w10 + lsig512_0 w02 + w01 + w18 = lsig512_1 w16 + w11 + lsig512_0 w03 + w02 + w19 = lsig512_1 w17 + w12 + lsig512_0 w04 + w03 + w20 = lsig512_1 w18 + w13 + lsig512_0 w05 + w04 + w21 = lsig512_1 w19 + w14 + lsig512_0 w06 + w05 + w22 = lsig512_1 w20 + w15 + lsig512_0 w07 + w06 + w23 = lsig512_1 w21 + w16 + lsig512_0 w08 + w07 + w24 = lsig512_1 w22 + w17 + lsig512_0 w09 + w08 + w25 = lsig512_1 w23 + w18 + lsig512_0 w10 + w09 + w26 = lsig512_1 w24 + w19 + lsig512_0 w11 + w10 + w27 = lsig512_1 w25 + w20 + lsig512_0 w12 + w11 + w28 = lsig512_1 w26 + w21 + lsig512_0 w13 + w12 + w29 = lsig512_1 w27 + w22 + lsig512_0 w14 + w13 + w30 = lsig512_1 w28 + w23 + lsig512_0 w15 + w14 + w31 = lsig512_1 w29 + w24 + lsig512_0 w16 + w15 + w32 = lsig512_1 w30 + w25 + lsig512_0 w17 + w16 + w33 = lsig512_1 w31 + w26 + lsig512_0 w18 + w17 + w34 = lsig512_1 w32 + w27 + lsig512_0 w19 + w18 + w35 = lsig512_1 w33 + w28 + lsig512_0 w20 + w19 + w36 = lsig512_1 w34 + w29 + lsig512_0 w21 + w20 + w37 = lsig512_1 w35 + w30 + lsig512_0 w22 + w21 + w38 = lsig512_1 w36 + w31 + lsig512_0 w23 + w22 + w39 = lsig512_1 w37 + w32 + lsig512_0 w24 + w23 + w40 = lsig512_1 w38 + w33 + lsig512_0 w25 + w24 + w41 = lsig512_1 w39 + w34 + lsig512_0 w26 + w25 + w42 = lsig512_1 w40 + w35 + lsig512_0 w27 + w26 + w43 = lsig512_1 w41 + w36 + lsig512_0 w28 + w27 + w44 = lsig512_1 w42 + w37 + lsig512_0 w29 + w28 + w45 = lsig512_1 w43 + w38 + lsig512_0 w30 + w29 + w46 = lsig512_1 w44 + w39 + lsig512_0 w31 + w30 + w47 = lsig512_1 w45 + w40 + lsig512_0 w32 + w31 + w48 = lsig512_1 w46 + w41 + lsig512_0 w33 + w32 + w49 = lsig512_1 w47 + w42 + lsig512_0 w34 + w33 + w50 = lsig512_1 w48 + w43 + lsig512_0 w35 + w34 + w51 = lsig512_1 w49 + w44 + lsig512_0 w36 + w35 + w52 = lsig512_1 w50 + w45 + lsig512_0 w37 + w36 + w53 = lsig512_1 w51 + w46 + lsig512_0 w38 + w37 + w54 = lsig512_1 w52 + w47 + lsig512_0 w39 + w38 + w55 = lsig512_1 w53 + w48 + lsig512_0 w40 + w39 + w56 = lsig512_1 w54 + w49 + lsig512_0 w41 + w40 + w57 = lsig512_1 w55 + w50 + lsig512_0 w42 + w41 + w58 = lsig512_1 w56 + w51 + lsig512_0 w43 + w42 + w59 = lsig512_1 w57 + w52 + lsig512_0 w44 + w43 + w60 = lsig512_1 w58 + w53 + lsig512_0 w45 + w44 + w61 = lsig512_1 w59 + w54 + lsig512_0 w46 + w45 + w62 = lsig512_1 w60 + w55 + lsig512_0 w47 + w46 + w63 = lsig512_1 w61 + w56 + lsig512_0 w48 + w47 + w64 = lsig512_1 w62 + w57 + lsig512_0 w49 + w48 + w65 = lsig512_1 w63 + w58 + lsig512_0 w50 + w49 + w66 = lsig512_1 w64 + w59 + lsig512_0 w51 + w50 + w67 = lsig512_1 w65 + w60 + lsig512_0 w52 + w51 + w68 = lsig512_1 w66 + w61 + lsig512_0 w53 + w52 + w69 = lsig512_1 w67 + w62 + lsig512_0 w54 + w53 + w70 = lsig512_1 w68 + w63 + lsig512_0 w55 + w54 + w71 = lsig512_1 w69 + w64 + lsig512_0 w56 + w55 + w72 = lsig512_1 w70 + w65 + lsig512_0 w57 + w56 + w73 = lsig512_1 w71 + w66 + lsig512_0 w58 + w57 + w74 = lsig512_1 w72 + w67 + lsig512_0 w59 + w58 + w75 = lsig512_1 w73 + w68 + lsig512_0 w60 + w59 + w76 = lsig512_1 w74 + w69 + lsig512_0 w61 + w60 + w77 = lsig512_1 w75 + w70 + lsig512_0 w62 + w61 + w78 = lsig512_1 w76 + w71 + lsig512_0 w63 + w62 + w79 = lsig512_1 w77 + w72 + lsig512_0 w64 + w63 + return $ SHA512Sched w00 w01 w02 w03 w04 w05 w06 w07 w08 w09 + w10 w11 w12 w13 w14 w15 w16 w17 w18 w19 + w20 w21 w22 w23 w24 w25 w26 w27 w28 w29 + w30 w31 w32 w33 w34 w35 w36 w37 w38 w39 + w40 w41 w42 w43 w44 w45 w46 w47 w48 w49 + w50 w51 w52 w53 w54 w55 w56 w57 w58 w59 + w60 w61 w62 w63 w64 w65 w66 w67 w68 w69 + w70 w71 w72 w73 w74 w75 w76 w77 w78 w79 + +processSHA512Block :: SHA512State -> Get SHA512State +processSHA512Block !s00@(SHA512S a00 b00 c00 d00 e00 f00 g00 h00) = do + (SHA512Sched w00 w01 w02 w03 w04 w05 w06 w07 w08 w09 + w10 w11 w12 w13 w14 w15 w16 w17 w18 w19 + w20 w21 w22 w23 w24 w25 w26 w27 w28 w29 + w30 w31 w32 w33 w34 w35 w36 w37 w38 w39 + w40 w41 w42 w43 w44 w45 w46 w47 w48 w49 + w50 w51 w52 w53 w54 w55 w56 w57 w58 w59 + w60 w61 w62 w63 w64 w65 w66 w67 w68 w69 + w70 w71 w72 w73 w74 w75 w76 w77 w78 w79) <- getSHA512Sched + let s01 = step512 s00 0x428a2f98d728ae22 w00 + s02 = step512 s01 0x7137449123ef65cd w01 + s03 = step512 s02 0xb5c0fbcfec4d3b2f w02 + s04 = step512 s03 0xe9b5dba58189dbbc w03 + s05 = step512 s04 0x3956c25bf348b538 w04 + s06 = step512 s05 0x59f111f1b605d019 w05 + s07 = step512 s06 0x923f82a4af194f9b w06 + s08 = step512 s07 0xab1c5ed5da6d8118 w07 + s09 = step512 s08 0xd807aa98a3030242 w08 + s10 = step512 s09 0x12835b0145706fbe w09 + s11 = step512 s10 0x243185be4ee4b28c w10 + s12 = step512 s11 0x550c7dc3d5ffb4e2 w11 + s13 = step512 s12 0x72be5d74f27b896f w12 + s14 = step512 s13 0x80deb1fe3b1696b1 w13 + s15 = step512 s14 0x9bdc06a725c71235 w14 + s16 = step512 s15 0xc19bf174cf692694 w15 + s17 = step512 s16 0xe49b69c19ef14ad2 w16 + s18 = step512 s17 0xefbe4786384f25e3 w17 + s19 = step512 s18 0x0fc19dc68b8cd5b5 w18 + s20 = step512 s19 0x240ca1cc77ac9c65 w19 + s21 = step512 s20 0x2de92c6f592b0275 w20 + s22 = step512 s21 0x4a7484aa6ea6e483 w21 + s23 = step512 s22 0x5cb0a9dcbd41fbd4 w22 + s24 = step512 s23 0x76f988da831153b5 w23 + s25 = step512 s24 0x983e5152ee66dfab w24 + s26 = step512 s25 0xa831c66d2db43210 w25 + s27 = step512 s26 0xb00327c898fb213f w26 + s28 = step512 s27 0xbf597fc7beef0ee4 w27 + s29 = step512 s28 0xc6e00bf33da88fc2 w28 + s30 = step512 s29 0xd5a79147930aa725 w29 + s31 = step512 s30 0x06ca6351e003826f w30 + s32 = step512 s31 0x142929670a0e6e70 w31 + s33 = step512 s32 0x27b70a8546d22ffc w32 + s34 = step512 s33 0x2e1b21385c26c926 w33 + s35 = step512 s34 0x4d2c6dfc5ac42aed w34 + s36 = step512 s35 0x53380d139d95b3df w35 + s37 = step512 s36 0x650a73548baf63de w36 + s38 = step512 s37 0x766a0abb3c77b2a8 w37 + s39 = step512 s38 0x81c2c92e47edaee6 w38 + s40 = step512 s39 0x92722c851482353b w39 + s41 = step512 s40 0xa2bfe8a14cf10364 w40 + s42 = step512 s41 0xa81a664bbc423001 w41 + s43 = step512 s42 0xc24b8b70d0f89791 w42 + s44 = step512 s43 0xc76c51a30654be30 w43 + s45 = step512 s44 0xd192e819d6ef5218 w44 + s46 = step512 s45 0xd69906245565a910 w45 + s47 = step512 s46 0xf40e35855771202a w46 + s48 = step512 s47 0x106aa07032bbd1b8 w47 + s49 = step512 s48 0x19a4c116b8d2d0c8 w48 + s50 = step512 s49 0x1e376c085141ab53 w49 + s51 = step512 s50 0x2748774cdf8eeb99 w50 + s52 = step512 s51 0x34b0bcb5e19b48a8 w51 + s53 = step512 s52 0x391c0cb3c5c95a63 w52 + s54 = step512 s53 0x4ed8aa4ae3418acb w53 + s55 = step512 s54 0x5b9cca4f7763e373 w54 + s56 = step512 s55 0x682e6ff3d6b2b8a3 w55 + s57 = step512 s56 0x748f82ee5defb2fc w56 + s58 = step512 s57 0x78a5636f43172f60 w57 + s59 = step512 s58 0x84c87814a1f0ab72 w58 + s60 = step512 s59 0x8cc702081a6439ec w59 + s61 = step512 s60 0x90befffa23631e28 w60 + s62 = step512 s61 0xa4506cebde82bde9 w61 + s63 = step512 s62 0xbef9a3f7b2c67915 w62 + s64 = step512 s63 0xc67178f2e372532b w63 + s65 = step512 s64 0xca273eceea26619c w64 + s66 = step512 s65 0xd186b8c721c0c207 w65 + s67 = step512 s66 0xeada7dd6cde0eb1e w66 + s68 = step512 s67 0xf57d4f7fee6ed178 w67 + s69 = step512 s68 0x06f067aa72176fba w68 + s70 = step512 s69 0x0a637dc5a2c898a6 w69 + s71 = step512 s70 0x113f9804bef90dae w70 + s72 = step512 s71 0x1b710b35131c471b w71 + s73 = step512 s72 0x28db77f523047d84 w72 + s74 = step512 s73 0x32caab7b40c72493 w73 + s75 = step512 s74 0x3c9ebe0a15c9bebc w74 + s76 = step512 s75 0x431d67c49c100d4c w75 + s77 = step512 s76 0x4cc5d4becb3e42b6 w76 + s78 = step512 s77 0x597f299cfc657e2a w77 + s79 = step512 s78 0x5fcb6fab3ad6faec w78 + s80 = step512 s79 0x6c44198c4a475817 w79 + SHA512S a80 b80 c80 d80 e80 f80 g80 h80 = s80 + return $ SHA512S (a00 + a80) (b00 + b80) (c00 + c80) (d00 + d80) + (e00 + e80) (f00 + f80) (g00 + g80) (h00 + h80) + +{-# INLINE step512 #-} +step512 :: SHA512State -> Word64 -> Word64 -> SHA512State +step512 !(SHA512S a b c d e f g h) k w = SHA512S a' b' c' d' e' f' g' h' + where + t1 = h + bsig512_1 e + ch e f g + k + w + t2 = bsig512_0 a + maj a b c + h' = g + g' = f + f' = e + e' = d + t1 + d' = c + c' = b + b' = a + a' = t1 + t2 + +runSHA :: a -> (a -> Get a) -> ByteString -> a +runSHA s nextChunk input = runGet (getAll s) input + where + getAll s_in = do + done <- isEmpty + if done + then return s_in + else nextChunk s_in >>= getAll + +sha512 :: ByteString -> Digest SHA512State +sha512 bs_in = Digest bs_out + where + bs_pad = padSHA512 bs_in + fstate = runSHA initialSHA512State processSHA512Block bs_pad + bs_out = runPut $ synthesizeSHA512 fstate + +sha512_spec_tests :: [(String, String)] +sha512_spec_tests = + [("abc", + "ddaf35a193617abacc417349ae20413112e6fa4e89a97ea20a9eeee64b55d39a" ++ + "2192992a274fc1a836ba3c23a3feebbd454d4423643ce80e2a9ac94fa54ca49f"), + ("abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmn" ++ + "hijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu", + "8e959b75dae313da8cf4f72814fc143f8f7779c6eb9f7fa17299aeadb6889018" ++ + "501d289e4900f7e4331b99dec4b5433ac7d329eeb6dd26545e96e55b874be909"), + (replicate 1000000 'a', + "e718483d0ce769644e2e42c7bc15b4638e1f98b13b2044285632a803afa973eb" ++ + "de0ff244877ea60a4cb0432ce577c31beb009c5c2c49aa2e4eadb217ad8cc09b")] + +showDigest :: Digest t -> String +showDigest (Digest bs) = showDigestBS bs + +-- |Prints out a bytestring in hexadecimal. Just for convenience. +showDigestBS :: ByteString -> String +showDigestBS bs = foldr paddedShowHex [] (BS.unpack bs) + where + paddedShowHex x xs = intToDigit (fromIntegral (x `shiftR` 4)) + : intToDigit (fromIntegral (x .&. 0xf)) + : xs + +main :: IO () +main = do + sequence_ + [ unless (digest == expected) + $ fail $ "failed: " ++ expected ++ " /= " ++ digest + | (str, expected) <- sha512_spec_tests + , let digest = showDigest (sha512 $ BSC.pack str) + ] ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -219,3 +219,4 @@ test('CallConv', [when(unregisterised(), skip), when(arch('x86_64'), extra_hc_opts('CallConv_x86_64.s')), when(arch('aarch64'), extra_hc_opts('CallConv_aarch64.s'))], compile_and_run, ['']) +test('T22798', normal, compile_and_run, ['-fregs-graph']) ===================================== testsuite/tests/ghci/T16392/T16392.script ===================================== @@ -1,5 +1,7 @@ :set -fobject-code +import System.Mem :load A.hs c_two caf +performMajorGC :load A.hs c_two caf ===================================== testsuite/tests/ghci/linking/dyn/Makefile ===================================== @@ -74,7 +74,7 @@ compile_libAB_dyn: '$(TEST_HC)' $(MY_TEST_HC_OPTS) -odir "bin_dyn" -shared B.c -o "bin_dyn/$(call DLL,B)" -lA -L"./bin_dyn" rm -f bin_dyn/*.a '$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -v0 -o "bin_dyn/$(call EXE,T10955dyn)" -L./bin_dyn -lB -lA T10955dyn.hs -v0 - LD_LIBRARY_PATH=./bin_dyn ./bin_dyn/$(call EXE,T10955dyn) + DYLD_LIBRARY_PATH=./bin_dyn LD_LIBRARY_PATH=./bin_dyn ./bin_dyn/$(call EXE,T10955dyn) .PHONY: compile_libAS_impl_gcc compile_libAS_impl_gcc: ===================================== testsuite/tests/rts/T18623/all.T ===================================== @@ -5,7 +5,10 @@ test('T18623', # This keeps failing on aarch64-linux for reasons that are not # fully clear. Maybe it needs a higher limit due to LLMV? when(arch('aarch64'), skip), + # Recent versions of osx report an error when running `ulimit -v` + when(opsys('darwin'), skip), + when(arch('powerpc64le'), skip), cmd_prefix('ulimit -v ' + str(1024 ** 2) + ' && '), ignore_stdout], run_command, - ['{compiler} --version']) \ No newline at end of file + ['{compiler} --version']) ===================================== testsuite/tests/simplCore/should_compile/T22623.hs ===================================== @@ -0,0 +1,34 @@ +{-# LANGUAGE GHC2021 #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module T22623 where + +import T22623a + +type BindNonEmptyList :: NonEmpty -> NonEmpty -> [Q] +type family BindNonEmptyList (x :: NonEmpty) (y :: NonEmpty) :: [Q] where + BindNonEmptyList ('(:|) a as) c = Tail c ++ Foldr2 a c as + +sBindNonEmptyList :: + forall (t :: NonEmpty) + (c :: NonEmpty). SNonEmpty t -> SNonEmpty c -> SList (BindNonEmptyList t c :: [Q]) +sBindNonEmptyList + ((:%|) (sA :: SQ a) (sAs :: SList as)) (sC :: SNonEmpty c) + = let + sMyHead :: SNonEmpty c -> SQ (MyHead a c) + sMyHead ((:%|) x _) = x + + sFoldr :: forall t. SList t -> SList (Foldr2 a c t) + sFoldr SNil = SNil + sFoldr (SCons _ sYs) = SCons (sMyHead sC) (sFoldr sYs) + + sF :: Id (SLambda (ConstSym1 c)) + sF = SLambda (const sC) + + sBs :: SList (Tail c) + _ :%| sBs = applySing sF sA + in + sBs %++ sFoldr sAs ===================================== testsuite/tests/simplCore/should_compile/T22623a.hs ===================================== @@ -0,0 +1,60 @@ +{-# LANGUAGE GHC2021 #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +module T22623a where + +import Data.Kind + +type Id :: Type -> Type +type family Id x +type instance Id x = x + +data Q +data SQ (x :: Q) + +data NonEmpty where + (:|) :: Q -> [Q] -> NonEmpty + +type Tail :: NonEmpty -> [Q] +type family Tail y where + Tail ('(:|) _ y) = y +type MyHead :: Q -> NonEmpty -> Q +type family MyHead x y where + MyHead _ ('(:|) c _) = c + +type SList :: [Q] -> Type +data SList z where + SNil :: SList '[] + SCons :: SQ x -> SList xs -> SList (x:xs) + +type SNonEmpty :: NonEmpty -> Type +data SNonEmpty z where + (:%|) :: SQ x -> SList xs -> SNonEmpty (x :| xs) + +data TyFun +type F = TyFun -> Type + +type Apply :: F -> Q -> NonEmpty +type family Apply f x + +type ConstSym1 :: NonEmpty -> F +data ConstSym1 (x :: NonEmpty) :: F +type instance Apply (ConstSym1 x) _ = x + +type SLambda :: F -> Type +newtype SLambda (f :: F) = + SLambda { applySing :: forall t. SQ t -> SNonEmpty (f `Apply` t) } + +type Foldr2 :: Q -> NonEmpty -> [Q] -> [Q] +type family Foldr2 a c x where + Foldr2 _ _ '[] = '[] + Foldr2 a c (_:ys) = MyHead a c : Foldr2 a c ys + +type (++) :: [Q] -> [Q] -> [Q] +type family (++) xs ys where + (++) '[] ys = ys + (++) ('(:) x xs) ys = '(:) x (xs ++ ys) + +(%++) :: forall (x :: [Q]) (y :: [Q]). SList x -> SList y -> SList (x ++ y) +(%++) SNil sYs = sYs +(%++) (SCons sX sXs) sYs = SCons sX (sXs %++ sYs) ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -367,3 +367,4 @@ test('T20200', normal, compile, ['']) test('T20820', normal, compile, ['-O0']) test('T22491', normal, compile, ['-O2']) test('T22662', normal, compile, ['']) +test('T22623', normal, multimod_compile, ['T22623', '-O -v0']) ===================================== testsuite/tests/stranal/should_compile/T22039.hs ===================================== @@ -0,0 +1,59 @@ +{-# LANGUAGE ExistentialQuantification #-} + +module Bug where + +import Control.Exception +import Data.Typeable +import Unsafe.Coerce + +data Error + = Error Int String + | forall e . Exception e => SomeError Int e + deriving (Typeable) + +fromError :: Exception e => Error -> Maybe e +fromError e@(Error _ _) = cast e +fromError (SomeError _ e) = cast e +-- {-# NOINLINE fromError #-} + +instance Eq Error where + Error i s == Error i' s' = i == i' && s == s' + SomeError i e == SomeError i' e' = i == i' && show e == show e' + _ == _ = False + +instance Show Error where + show _ = "" + +instance Exception Error + +-- newtype +data + UniquenessError = UniquenessError [((String, String), Int)] + deriving (Show, Eq) + +instance Exception UniquenessError + +test :: SomeException -> IO () +test e = case fromError =<< fromException e :: Maybe UniquenessError of + Just err -> print err + _ -> pure () + +-- +-- Smaller reproducer by sgraf +-- + +blarg :: (Int,Int) -> Int +blarg (x,y) = x+y +{-# NOINLINE blarg #-} + +f :: Either Int Int -> Int +f Left{} = 0 +f e = blarg (unsafeCoerce e) + +blurg :: (Int -> Int) -> Int +blurg f = f 42 +{-# NOINLINE blurg #-} + +g :: Either Int Int -> Int +g Left{} = 0 +g e = blurg (unsafeCoerce e) ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -69,3 +69,4 @@ test('T20663', [ grep_errmsg(r'\$wyeah ::') ], compile, ['-dppr-cols=1000 -ddump test('T19180', normal, compile, ['']) test('T19849', normal, compile, ['']) +test('T22039', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1f212a7184c36c3149418afa1ac43173911f628b...9c35e76f94d059e6d751ad4585f4913864402d48 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1f212a7184c36c3149418afa1ac43173911f628b...9c35e76f94d059e6d751ad4585f4913864402d48 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 19:08:12 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Thu, 02 Feb 2023 14:08:12 -0500 Subject: [Git][ghc/ghc][wip/andreask/infer-bytecode] Fix some correctness issues around tag inference when targeting the bytecode generator. Message-ID: <63dc0a1c34347_1108fe52620251235@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/infer-bytecode at Glasgow Haskell Compiler / GHC Commits: eefc367d by Andreas Klebinger at 2023-02-02T20:07:27+01:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9 changed files: - compiler/GHC/Driver/Config/Stg/Pipeline.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Types.hs - compiler/GHC/Stg/Pipeline.hs - + testsuite/tests/simplStg/should_compile/T22840.hs - + testsuite/tests/simplStg/should_compile/T22840.stderr - + testsuite/tests/simplStg/should_compile/T22840A.hs - + testsuite/tests/simplStg/should_compile/T22840B.hs - testsuite/tests/simplStg/should_compile/all.T Changes: ===================================== compiler/GHC/Driver/Config/Stg/Pipeline.hs ===================================== @@ -22,6 +22,7 @@ initStgPipelineOpts dflags for_bytecode = StgPipelineOpts , stgPipeline_pprOpts = initStgPprOpts dflags , stgPipeline_phases = getStgToDo for_bytecode dflags , stgPlatform = targetPlatform dflags + , stgPipeline_forBytecode = for_bytecode } -- | Which Stg-to-Stg passes to run. Depends on flags, ways etc. ===================================== compiler/GHC/Stg/InferTags.hs ===================================== @@ -204,6 +204,33 @@ a different StgPass! To handle this a large part of the analysis is polymorphic over the exact StgPass we are using. Which allows us to run the analysis on the output of itself. +Note [Tag inference for interpreted code] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The bytecode interpreter has a different behaviour when it comes +to the tagging of binders in certain situations than the StgToCmm code generator. + +a) Tags for let-bindings: + + When compiling a binding for a constructor like `let x = Just True` + Weither or not `x` results in x pointing depends on the backend. + For the interpreter x points to a BCO which once + evaluated returns a properly tagged pointer to the heap object. + In the Cmm backend for the same binding we would allocate the constructor right + away and x will immediately be represented by a tagged pointer. + This means for interpreted code we can not assume let bound constructors are + properly tagged. Hence we distinguish between targeting bytecode and native in + the analysis. + We make this differentiation in `mkLetSig` where we simply never assume + lets are tagged when targeting bytecode. + +b) When referencing ids from other modules the Cmm backend will try to put a + proper tag on these references through various means. When doing analysis we + usually predict these cases to improve precision of the analysis. + But to my knowledge the bytecode generator makes no such attempts so we must + not infer imported bindings as tagged. + This is handled in GHC.Stg.InferTags.Types.lookupInfo + + -} {- ********************************************************************* @@ -212,20 +239,12 @@ the output of itself. * * ********************************************************************* -} --- doCodeGen :: HscEnv -> Module -> InfoTableProvMap -> [TyCon] --- -> CollectedCCs --- -> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs --- -> HpcInfo --- -> IO (Stream IO CmmGroupSRTs CmmCgInfos) --- -- Note we produce a 'Stream' of CmmGroups, so that the --- -- backend can be run incrementally. Otherwise it generates all --- -- the C-- up front, which has a significant space cost. -inferTags :: StgPprOpts -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) -inferTags ppr_opts logger this_mod stg_binds = do - +inferTags :: StgPprOpts -> Bool -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) +inferTags ppr_opts !for_bytecode logger this_mod stg_binds = do + -- pprTraceM "inferTags for " (ppr this_mod <> text " bytecode:" <> ppr for_bytecode) -- Annotate binders with tag information. let (!stg_binds_w_tags) = {-# SCC "StgTagFields" #-} - inferTagsAnal stg_binds + inferTagsAnal for_bytecode stg_binds putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings ppr_opts stg_binds_w_tags) let export_tag_info = collectExportInfo stg_binds_w_tags @@ -254,10 +273,10 @@ type InferExtEq i = ( XLet i ~ XLet 'InferTaggedBinders , XLetNoEscape i ~ XLetNoEscape 'InferTaggedBinders , XRhsClosure i ~ XRhsClosure 'InferTaggedBinders) -inferTagsAnal :: [GenStgTopBinding 'CodeGen] -> [GenStgTopBinding 'InferTaggedBinders] -inferTagsAnal binds = +inferTagsAnal :: Bool -> [GenStgTopBinding 'CodeGen] -> [GenStgTopBinding 'InferTaggedBinders] +inferTagsAnal for_bytecode binds = -- pprTrace "Binds" (pprGenStgTopBindings shortStgPprOpts $ binds) $ - snd (mapAccumL inferTagTopBind initEnv binds) + snd (mapAccumL inferTagTopBind (initEnv for_bytecode) binds) ----------------------- inferTagTopBind :: TagEnv 'CodeGen -> GenStgTopBinding 'CodeGen @@ -420,11 +439,12 @@ inferTagBind in_env (StgNonRec bndr rhs) -- ppr bndr $$ -- ppr (isDeadEndId id) $$ -- ppr sig) - (env', StgNonRec (id, sig) rhs') + (env', StgNonRec (id, out_sig) rhs') where id = getBinderId in_env bndr - env' = extendSigEnv in_env [(id, sig)] - (sig,rhs') = inferTagRhs id in_env rhs + (in_sig,rhs') = inferTagRhs id in_env rhs + out_sig = mkLetSig in_env in_sig + env' = extendSigEnv in_env [(id, out_sig)] inferTagBind in_env (StgRec pairs) = -- pprTrace "rec" (ppr (map fst pairs) $$ ppr (in_env { te_env = out_env }, StgRec pairs')) $ @@ -443,14 +463,17 @@ inferTagBind in_env (StgRec pairs) | in_sigs == out_sigs = (te_env rhs_env, out_bndrs `zip` rhss') | otherwise = go env' out_sigs rhss' where - out_bndrs = map updateBndr in_bndrs -- TODO: Keeps in_ids alive in_bndrs = in_ids `zip` in_sigs + out_bndrs = map updateBndr in_bndrs -- TODO: Keeps in_ids alive rhs_env = extendSigEnv go_env in_bndrs (out_sigs, rhss') = unzip (zipWithEqual "inferTagBind" anaRhs in_ids go_rhss) env' = makeTagged go_env anaRhs :: Id -> GenStgRhs q -> (TagSig, GenStgRhs 'InferTaggedBinders) - anaRhs bnd rhs = inferTagRhs bnd rhs_env rhs + anaRhs bnd rhs = + let (sig_rhs,rhs') = inferTagRhs bnd rhs_env rhs + in (mkLetSig go_env sig_rhs, rhs') + updateBndr :: (Id,TagSig) -> (Id,TagSig) updateBndr (v,sig) = (setIdTagSig v sig, sig) @@ -536,6 +559,15 @@ inferTagRhs _ env _rhs@(StgRhsCon cc con cn ticks args) = --pprTrace "inferTagRhsCon" (ppr grp_ids) $ (TagSig (inferConTag env con args), StgRhsCon cc con cn ticks args) +-- Adjust let semantics to the targeted backend. +-- See Note [Tag inference for interpreted code] +mkLetSig :: TagEnv p -> TagSig -> TagSig +mkLetSig env in_sig + | for_bytecode = TagSig TagDunno + | otherwise = in_sig + where + for_bytecode = te_bytecode env + {- Note [Constructor TagSigs] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @inferConTag@ will infer the proper tag signature for a binding who's RHS is a constructor ===================================== compiler/GHC/Stg/InferTags/Types.hs ===================================== @@ -49,24 +49,30 @@ combineAltInfo ti TagTagged = ti type TagSigEnv = IdEnv TagSig data TagEnv p = TE { te_env :: TagSigEnv , te_get :: BinderP p -> Id + , te_bytecode :: !Bool } instance Outputable (TagEnv p) where - ppr te = ppr (te_env te) - + ppr te = for_txt <+> ppr (te_env te) + where + for_txt = if te_bytecode te + then text "for_bytecode" + else text "for_native" getBinderId :: TagEnv p -> BinderP p -> Id getBinderId = te_get -initEnv :: TagEnv 'CodeGen -initEnv = TE { te_env = emptyVarEnv - , te_get = \x -> x} +initEnv :: Bool -> TagEnv 'CodeGen +initEnv for_bytecode = TE { te_env = emptyVarEnv + , te_get = \x -> x + , te_bytecode = for_bytecode } -- | Simple convert env to a env of the 'InferTaggedBinders pass -- with no other changes. makeTagged :: TagEnv p -> TagEnv 'InferTaggedBinders makeTagged env = TE { te_env = te_env env - , te_get = fst } + , te_get = fst + , te_bytecode = te_bytecode env } noSig :: TagEnv p -> BinderP p -> (Id, TagSig) noSig env bndr @@ -75,14 +81,18 @@ noSig env bndr where var = getBinderId env bndr +-- | Look up a sig in the given env lookupSig :: TagEnv p -> Id -> Maybe TagSig lookupSig env fun = lookupVarEnv (te_env env) fun +-- | Look up a sig in the env or derive it from information +-- in the arg itself. lookupInfo :: TagEnv p -> StgArg -> TagInfo lookupInfo env (StgVarArg var) -- Nullary data constructors like True, False | Just dc <- isDataConWorkId_maybe var , isNullaryRepDataCon dc + , not for_bytecode = TagProper | isUnliftedType (idType var) @@ -93,6 +103,7 @@ lookupInfo env (StgVarArg var) = info | Just lf_info <- idLFInfo_maybe var + , not for_bytecode = case lf_info of -- Function, tagged (with arity) LFReEntrant {} @@ -112,6 +123,8 @@ lookupInfo env (StgVarArg var) | otherwise = TagDunno + where + for_bytecode = te_bytecode env lookupInfo _ (StgLitArg {}) = TagProper ===================================== compiler/GHC/Stg/Pipeline.hs ===================================== @@ -50,6 +50,7 @@ data StgPipelineOpts = StgPipelineOpts -- ^ Should we lint the STG at various stages of the pipeline? , stgPipeline_pprOpts :: !StgPprOpts , stgPlatform :: !Platform + , stgPipeline_forBytecode :: !Bool } newtype StgM a = StgM { _unStgM :: ReaderT Char IO a } @@ -89,7 +90,7 @@ stg2stg logger extra_vars opts this_mod binds -- annotations (which is used by code generator to compute offsets into closures) ; let binds_sorted_with_fvs = depSortWithAnnotStgPgm this_mod binds' -- See Note [Tag inference for interactive contexts] - ; inferTags (stgPipeline_pprOpts opts) logger this_mod binds_sorted_with_fvs + ; inferTags (stgPipeline_pprOpts opts) (stgPipeline_forBytecode opts) logger this_mod binds_sorted_with_fvs } where ===================================== testsuite/tests/simplStg/should_compile/T22840.hs ===================================== @@ -0,0 +1,14 @@ +{-# OPTIONS_GHC -fwrite-if-simplified-core -fbyte-code-and-object-code -fprefer-byte-code #-} +{-# LANGUAGE TemplateHaskell #-} + +module C where + +import T22840A +import T22840B +import Control.Monad.IO.Class + +$(liftIO $ do + putStrLn "start" + putStrLn (disp theT) + putStrLn "end" + return []) ===================================== testsuite/tests/simplStg/should_compile/T22840.stderr ===================================== @@ -0,0 +1,6 @@ +[1 of 3] Compiling T22840A ( T22840A.hs, T22840A.o, T22840A.dyn_o ) +[2 of 3] Compiling T22840B ( T22840B.hs, T22840B.o, T22840B.dyn_o, interpreted ) +[3 of 3] Compiling C ( T22840.hs, T22840.o, T22840.dyn_o, interpreted ) +start +Just +end ===================================== testsuite/tests/simplStg/should_compile/T22840A.hs ===================================== @@ -0,0 +1,9 @@ +module T22840A where + +data T = MkT !(Maybe Bool) + +disp :: T -> String +disp (MkT b) = + case b of + Nothing -> "Nothing" + Just _ -> "Just" ===================================== testsuite/tests/simplStg/should_compile/T22840B.hs ===================================== @@ -0,0 +1,8 @@ +{-# OPTIONS_GHC -fwrite-if-simplified-core -fbyte-code-and-object-code -fprefer-byte-code #-} + +module T22840B where + +import T22840A + +theT :: T +theT = MkT (Just True) ===================================== testsuite/tests/simplStg/should_compile/all.T ===================================== @@ -14,3 +14,7 @@ test('T19717', normal, compile, ['-ddump-stg-final -dsuppress-uniques -dno-typea test('inferTags002', [ only_ways(['optasm']), grep_errmsg(r'(call stg\_ap\_0)', [1])], compile, ['-ddump-cmm -dsuppress-uniques -dno-typeable-binds -O']) test('T22212', normal, compile, ['-O']) +test('T22840', [extra_files( + [ 'T22840A.hs' + , 'T22840B.hs' + ])], multimod_compile, ['T22840', '-dynamic-too -dtag-inference-checks']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eefc367ddc6bf5cff6bb6cd115d0d1762f226490 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eefc367ddc6bf5cff6bb6cd115d0d1762f226490 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 19:40:58 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Thu, 02 Feb 2023 14:40:58 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/t21766 Message-ID: <63dc11ca70ba4_1108fe52634257866@gitlab.mail> Finley McIlwaine pushed new branch wip/t21766 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/t21766 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 19:50:24 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Thu, 02 Feb 2023 14:50:24 -0500 Subject: [Git][ghc/ghc][wip/9.2.6-backports] Fix warnings Message-ID: <63dc14001954f_1108fe5265c259923@gitlab.mail> Zubin pushed to branch wip/9.2.6-backports at Glasgow Haskell Compiler / GHC Commits: 86e659f1 by Zubin Duggal at 2023-02-03T01:19:25+05:30 Fix warnings - - - - - 1 changed file: - compiler/GHC.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -358,7 +358,6 @@ import GHC.Utils.Monad import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic -import GHC.Utils.Panic.Plain import GHC.Utils.Logger import GHC.Core.Predicate View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86e659f1fe85a4e6d46a439efb664b9dac152e38 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86e659f1fe85a4e6d46a439efb664b9dac152e38 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 20:32:29 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Thu, 02 Feb 2023 15:32:29 -0500 Subject: [Git][ghc/ghc][wip/9.2.6-backports] 11 commits: ghc-the-library: Retain cafs in both static in dynamic builds. Message-ID: <63dc1dddeedc3_1108fec035f026844d@gitlab.mail> Zubin pushed to branch wip/9.2.6-backports at Glasgow Haskell Compiler / GHC Commits: a02bfe28 by Andreas Klebinger at 2023-02-03T02:01:23+05:30 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- (cherry picked from commit 08ba87200ff068aa37cac082e61ee7e2d534daf5) - - - - - 883068ff by Matthew Pickering at 2023-02-03T02:01:23+05:30 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s (cherry picked from commit a960ca817d6ad0109ea6edda50da3902cc538e86) - - - - - 898cf5ba by Matthew Pickering at 2023-02-03T02:01:23+05:30 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. (cherry picked from commit 734847108420cf826a807c30ad54651659cf3a08) - - - - - ec15304a by Matthew Pickering at 2023-02-03T02:01:23+05:30 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes (cherry picked from commit 8c0ea25fb4a27d4729aabf73f4c00b912bb0c58d) - - - - - f3c969a9 by Cheng Shao at 2023-02-03T02:01:23+05:30 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. (cherry picked from commit c45a5fffef2c76efbf5d3a009c3f6d0244a63f0d) - - - - - 59f2862d by Ben Gamari at 2023-02-03T02:01:23+05:30 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. (cherry picked from commit be417a47c7695998dea0adc05489a7b8838a78b6) - - - - - f5f1a5cd by Ben Gamari at 2023-02-03T02:01:23+05:30 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. (cherry picked from commit 30989d137b8f3a8fddbfd116e04b48f23c24f86c) - - - - - ca157ac5 by Ben Gamari at 2023-02-03T02:01:23+05:30 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. (cherry picked from commit 7566fd9de38c67360c090f828923d41587af519c) - - - - - e07afc94 by Ben Gamari at 2023-02-03T02:01:23+05:30 testsuite: Add regression test for #22798 (cherry picked from commit 2cb500a5ee1a31dfe1a2cdd71f175442026eb082) - - - - - ff480c77 by Zubin Duggal at 2023-02-03T02:01:23+05:30 hadrian: enable -haddock in perf flavour (#22734) - - - - - bcb79aea by Zubin Duggal at 2023-02-03T02:01:24+05:30 Fix warnings - - - - - 13 changed files: - compiler/GHC.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/cbits/keepCAFsForGHCi.c - compiler/ghc.mk - configure.ac - hadrian/src/Settings/Flavours/Performance.hs - + m4/fp_ld_no_fixup_chains.m4 - + testsuite/tests/codeGen/should_run/T22798.hs - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/ghci/T16392/T16392.script - testsuite/tests/ghci/linking/dyn/Makefile - testsuite/tests/rts/T18623/all.T Changes: ===================================== compiler/GHC.hs ===================================== @@ -554,7 +554,12 @@ withCleanupSession ghc = ghc `MC.finally` cleanup initGhcMonad :: GhcMonad m => Maybe FilePath -> m () initGhcMonad mb_top_dir - = do { env <- liftIO $ + = do { -- The call to c_keepCAFsForGHCi must not be optimized away. Even in non-debug builds. + -- So we can't use assertM here. + -- See Note [keepCAFsForGHCi] in keepCAFsForGHCi.c for details about why. + !keep_cafs <- liftIO $ c_keepCAFsForGHCi + ; MASSERT( keep_cafs ) + ; env <- liftIO $ do { top_dir <- findTopDir mb_top_dir ; mySettings <- initSysTools top_dir ; myLlvmConfig <- lazyInitLlvmConfig top_dir @@ -600,7 +605,6 @@ checkBrokenTablesNextToCode' logger dflags arch = platformArch platform tablesNextToCode = platformTablesNextToCode platform - -- %************************************************************************ -- %* * -- Flags & settings @@ -1931,3 +1935,5 @@ instance Exception GhcApiError mkApiErr :: DynFlags -> SDoc -> GhcApiError mkApiErr dflags msg = GhcApiError (showSDoc dflags msg) +foreign import ccall unsafe "keepCAFsForGHCi" + c_keepCAFsForGHCi :: IO Bool ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -73,6 +73,11 @@ instance Outputable RegUsage where regUsageOfInstr :: Platform -> Instr -> RegUsage regUsageOfInstr platform instr = case instr of ANN _ i -> regUsageOfInstr platform i + COMMENT{} -> usage ([], []) + PUSH_STACK_FRAME -> usage ([], []) + POP_STACK_FRAME -> usage ([], []) + DELTA{} -> usage ([], []) + -- 1. Arithmetic Instructions ------------------------------------------------ ADD dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) CMN l r -> usage (regOp l ++ regOp r, []) @@ -137,7 +142,7 @@ regUsageOfInstr platform instr = case instr of FCVTZS dst src -> usage (regOp src, regOp dst) FABS dst src -> usage (regOp src, regOp dst) - _ -> panic "regUsageOfInstr" + _ -> panic $ "regUsageOfInstr: " ++ instrCon instr where -- filtering the usage is necessary, otherwise the register @@ -203,7 +208,11 @@ callerSavedRegisters patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr patchRegsOfInstr instr env = case instr of -- 0. Meta Instructions - ANN d i -> ANN d (patchRegsOfInstr i env) + ANN d i -> ANN d (patchRegsOfInstr i env) + COMMENT{} -> instr + PUSH_STACK_FRAME -> instr + POP_STACK_FRAME -> instr + DELTA{} -> instr -- 1. Arithmetic Instructions ---------------------------------------------- ADD o1 o2 o3 -> ADD (patchOp o1) (patchOp o2) (patchOp o3) CMN o1 o2 -> CMN (patchOp o1) (patchOp o2) @@ -269,8 +278,7 @@ patchRegsOfInstr instr env = case instr of SCVTF o1 o2 -> SCVTF (patchOp o1) (patchOp o2) FCVTZS o1 o2 -> FCVTZS (patchOp o1) (patchOp o2) FABS o1 o2 -> FABS (patchOp o1) (patchOp o2) - - _ -> pprPanic "patchRegsOfInstr" (text $ show instr) + _ -> panic $ "patchRegsOfInstr: " ++ instrCon instr where patchOp :: Operand -> Operand patchOp (OpReg w r) = OpReg w (env r) @@ -326,7 +334,7 @@ patchJumpInstr instr patchF B (TBlock bid) -> B (TBlock (patchF bid)) BL (TBlock bid) ps rs -> BL (TBlock (patchF bid)) ps rs BCOND c (TBlock bid) -> BCOND c (TBlock (patchF bid)) - _ -> pprPanic "patchJumpInstr" (text $ show instr) + _ -> panic $ "patchJumpInstr: " ++ instrCon instr -- ----------------------------------------------------------------------------- -- Note [Spills and Reloads] @@ -638,10 +646,69 @@ data Instr -- Float ABSolute value | FABS Operand Operand -instance Show Instr where - show (LDR _f o1 o2) = "LDR " ++ show o1 ++ ", " ++ show o2 - show (MOV o1 o2) = "MOV " ++ show o1 ++ ", " ++ show o2 - show _ = "missing" +instrCon :: Instr -> String +instrCon i = + case i of + COMMENT{} -> "COMMENT" + MULTILINE_COMMENT{} -> "COMMENT" + ANN{} -> "ANN" + LOCATION{} -> "LOCATION" + LDATA{} -> "LDATA" + NEWBLOCK{} -> "NEWBLOCK" + DELTA{} -> "DELTA" + SXTB{} -> "SXTB" + UXTB{} -> "UXTB" + SXTH{} -> "SXTH" + UXTH{} -> "UXTH" + PUSH_STACK_FRAME{} -> "PUSH_STACK_FRAME" + POP_STACK_FRAME{} -> "POP_STACK_FRAME" + ADD{} -> "ADD" + CMN{} -> "CMN" + CMP{} -> "CMP" + MSUB{} -> "MSUB" + MUL{} -> "MUL" + NEG{} -> "NEG" + SDIV{} -> "SDIV" + SMULH{} -> "SMULH" + SMULL{} -> "SMULL" + SUB{} -> "SUB" + UDIV{} -> "UDIV" + SBFM{} -> "SBFM" + UBFM{} -> "UBFM" + SBFX{} -> "SBFX" + UBFX{} -> "UBFX" + AND{} -> "AND" + ANDS{} -> "ANDS" + ASR{} -> "ASR" + BIC{} -> "BIC" + BICS{} -> "BICS" + EON{} -> "EON" + EOR{} -> "EOR" + LSL{} -> "LSL" + LSR{} -> "LSR" + MOV{} -> "MOV" + MOVK{} -> "MOVK" + MVN{} -> "MVN" + ORN{} -> "ORN" + ORR{} -> "ORR" + ROR{} -> "ROR" + TST{} -> "TST" + STR{} -> "STR" + LDR{} -> "LDR" + STP{} -> "STP" + LDP{} -> "LDP" + CSET{} -> "CSET" + CBZ{} -> "CBZ" + CBNZ{} -> "CBNZ" + J{} -> "J" + B{} -> "B" + BL{} -> "BL" + BCOND{} -> "BCOND" + DMBSY{} -> "DMBSY" + FCVT{} -> "FCVT" + SCVTF{} -> "SCVTF" + FCVTZS{} -> "FCVTZS" + FABS{} -> "FABS" data Target = TBlock BlockId @@ -769,11 +836,11 @@ opRegUExt W64 r = OpRegExt W64 r EUXTX 0 opRegUExt W32 r = OpRegExt W32 r EUXTW 0 opRegUExt W16 r = OpRegExt W16 r EUXTH 0 opRegUExt W8 r = OpRegExt W8 r EUXTB 0 -opRegUExt w _r = pprPanic "opRegUExt" (text $ show w) +opRegUExt w _r = pprPanic "opRegUExt" (ppr w) opRegSExt :: Width -> Reg -> Operand opRegSExt W64 r = OpRegExt W64 r ESXTX 0 opRegSExt W32 r = OpRegExt W32 r ESXTW 0 opRegSExt W16 r = OpRegExt W16 r ESXTH 0 opRegSExt W8 r = OpRegExt W8 r ESXTB 0 -opRegSExt w _r = pprPanic "opRegSExt" (text $ show w) +opRegSExt w _r = pprPanic "opRegSExt" (ppr w) ===================================== compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs ===================================== @@ -115,10 +115,8 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcInteger conflicts excl ArchSPARC64 -> panic "trivColorable ArchSPARC64" ArchPPC_64 _ -> 15 ArchARM _ _ _ -> panic "trivColorable ArchARM" - -- We should be able to allocate *a lot* more in princple. - -- essentially all 32 - SP, so 31, we'd trash the link reg - -- as well as the platform and all others though. - ArchAArch64 -> 18 + -- N.B. x18 is reserved by the platform on AArch64/Darwin + ArchAArch64 -> 17 ArchAlpha -> panic "trivColorable ArchAlpha" ArchMipseb -> panic "trivColorable ArchMipseb" ArchMipsel -> panic "trivColorable ArchMipsel" ===================================== compiler/cbits/keepCAFsForGHCi.c ===================================== @@ -1,15 +1,35 @@ #include +#include +// Note [keepCAFsForGHCi] +// ~~~~~~~~~~~~~~~~~~~~~~ // This file is only included in the dynamic library. // It contains an __attribute__((constructor)) function (run prior to main()) // which sets the keepCAFs flag in the RTS, before any Haskell code is run. // This is required so that GHCi can use dynamic libraries instead of HSxyz.o // files. +// +// For static builds we have to guarantee that the linker loads this object file +// to ensure the constructor gets run and not discarded. If the object is part of +// an archive and not otherwise referenced the linker would ignore the object. +// To avoid this: +// * When initializing a GHC session in initGhcMonad we assert keeping cafs has been +// enabled by calling keepCAFsForGHCi. +// * This causes the GHC module from the ghc package to carry a reference to this object +// file. +// * Which in turn ensures the linker doesn't discard this object file, causing +// the constructor to be run, allowing the assertion to succeed in the first place +// as keepCAFs will have been set already during initialization of constructors. -static void keepCAFsForGHCi(void) __attribute__((constructor)); -static void keepCAFsForGHCi(void) + +bool keepCAFsForGHCi(void) __attribute__((constructor)); + +bool keepCAFsForGHCi(void) { - keepCAFs = 1; + bool was_set = keepCAFs; + setKeepCAFs(); + return was_set; } + ===================================== compiler/ghc.mk ===================================== @@ -288,20 +288,6 @@ $(eval $(call build-package,compiler,stage1,0)) $(eval $(call build-package,compiler,stage2,1)) $(eval $(call build-package,compiler,stage3,2)) -# We only want to turn keepCAFs on if we will be loading dynamic -# Haskell libraries with GHCi. We therefore filter the object file -# out for non-dynamic ways. -define keepCAFsForGHCiDynOnly -# $1 = stage -# $2 = way -ifeq "$$(findstring dyn, $2)" "" -compiler_stage$1_$2_C_OBJS := $$(filter-out %/keepCAFsForGHCi.$$($2_osuf),$$(compiler_stage$1_$2_C_OBJS)) -endif -endef -$(foreach w,$(compiler_stage1_WAYS),$(eval $(call keepCAFsForGHCiDynOnly,1,$w))) -$(foreach w,$(compiler_stage2_WAYS),$(eval $(call keepCAFsForGHCiDynOnly,2,$w))) -$(foreach w,$(compiler_stage3_WAYS),$(eval $(call keepCAFsForGHCiDynOnly,3,$w))) - # after build-package, because that adds --enable-library-for-ghci # to compiler_stage*_CONFIGURE_OPTS: # We don't build the GHCi library for the ghc package. We can load it ===================================== configure.ac ===================================== @@ -780,6 +780,10 @@ FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE1],[CONF_GCC_LINKER_OPTS_STAG FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE2],[CONF_GCC_LINKER_OPTS_STAGE2],[CONF_LD_LINKER_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2]) # Stage 3 won't be supported by cross-compilation +FP_LD_NO_FIXUP_CHAINS([target], [LDFLAGS]) +FP_LD_NO_FIXUP_CHAINS([build], [CONF_GCC_LINKER_OPTS_STAGE0]) +FP_LD_NO_FIXUP_CHAINS([target], [CONF_GCC_LINKER_OPTS_STAGE1]) +FP_LD_NO_FIXUP_CHAINS([target], [CONF_GCC_LINKER_OPTS_STAGE2]) dnl ** See whether cc supports --target= and set dnl CONF_CC_OPTS_STAGE[12] accordingly. FP_CC_SUPPORTS_TARGET ===================================== hadrian/src/Settings/Flavours/Performance.hs ===================================== @@ -13,6 +13,6 @@ performanceFlavour = defaultFlavour performanceArgs :: Args performanceArgs = sourceArgs SourceArgs { hsDefault = pure ["-O", "-H64m"] - , hsLibrary = notStage0 ? arg "-O2" + , hsLibrary = mconcat [notStage0 ? arg "-O2", notStage0 ? arg "-haddock"] , hsCompiler = pure ["-O2"] , hsGhc = mconcat [stage0 ? arg "-O", notStage0 ? arg "-O2"] } ===================================== m4/fp_ld_no_fixup_chains.m4 ===================================== @@ -0,0 +1,24 @@ +# FP_LD_NO_FIXUP_CHAINS +# -------------------- +# See if whether we are using a version of ld64 on darwin platforms which +# requires us to pass -no_fixup_chains +# +# $1 = the platform +# $2 = the name of the linker flags variable when linking with $CC +AC_DEFUN([FP_LD_NO_FIXUP_CHAINS], [ + case $$1 in + *-darwin) + AC_MSG_CHECKING([whether ld64 requires -no_fixup_chains]) + echo 'int main(void) {return 0;}' > conftest.c + if $CC -o conftest.o -Wl,-no_fixup_chains conftest.c > /dev/null 2>&1 + then + $2="-Wl,-no_fixup_chains" + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + fi + rm -f conftest.c conftest.o + ;; + + esac +]) ===================================== testsuite/tests/codeGen/should_run/T22798.hs ===================================== @@ -0,0 +1,375 @@ +-- Derived from SHA-1.5.0.0 +-- This previously uncovered cases left unhandled in the AArch64 NCG (#22798). + +{-# LANGUAGE BangPatterns, CPP, FlexibleInstances #-} +module Main (main) where + +import Data.Binary +import Data.Binary.Get +import Data.Binary.Put +import Data.Bits +import Data.ByteString.Lazy(ByteString) +import Data.ByteString.Lazy.Char8 as BSC (pack) +import qualified Data.ByteString.Lazy as BS +import Data.Char (intToDigit) +import Control.Monad + +newtype Digest t = Digest ByteString + +data SHA512State = SHA512S !Word64 !Word64 !Word64 !Word64 + !Word64 !Word64 !Word64 !Word64 + +initialSHA512State :: SHA512State +initialSHA512State = SHA512S 0x6a09e667f3bcc908 0xbb67ae8584caa73b + 0x3c6ef372fe94f82b 0xa54ff53a5f1d36f1 + 0x510e527fade682d1 0x9b05688c2b3e6c1f + 0x1f83d9abfb41bd6b 0x5be0cd19137e2179 + + +synthesizeSHA512 :: SHA512State -> Put +synthesizeSHA512 (SHA512S a b c d e f g h) = do + putWord64be a + putWord64be b + putWord64be c + putWord64be d + putWord64be e + putWord64be f + putWord64be g + putWord64be h + +getSHA512 :: Get SHA512State +getSHA512 = do + a <- getWord64be + b <- getWord64be + c <- getWord64be + d <- getWord64be + e <- getWord64be + f <- getWord64be + g <- getWord64be + h <- getWord64be + return $ SHA512S a b c d e f g h + +instance Binary SHA512State where + put = synthesizeSHA512 + get = getSHA512 + +padSHA512 :: ByteString -> ByteString +padSHA512 = generic_pad 896 1024 128 + +generic_pad :: Word64 -> Word64 -> Int -> ByteString -> ByteString +generic_pad a b lSize bs = BS.concat [bs, pad_bytes, pad_length] + where + l = fromIntegral $ BS.length bs * 8 + k = calc_k a b l + -- INVARIANT: k is necessarily > 0, and (k + 1) is a multiple of 8. + k_bytes = (k + 1) `div` 8 + pad_bytes = BS.singleton 0x80 `BS.append` BS.replicate nZeroBytes 0 + nZeroBytes = fromIntegral $ k_bytes - 1 + pad_length = toBigEndianBS lSize l + +-- Given a, b, and l, calculate the smallest k such that (l + 1 + k) mod b = a. +calc_k :: Word64 -> Word64 -> Word64 -> Word64 +calc_k a b l = + if r <= -1 + then fromIntegral r + b + else fromIntegral r + where + r = toInteger a - toInteger l `mod` toInteger b - 1 + +toBigEndianBS :: (Integral a, Bits a) => Int -> a -> ByteString +toBigEndianBS s val = BS.pack $ map getBits [s - 8, s - 16 .. 0] + where + getBits x = fromIntegral $ (val `shiftR` x) .&. 0xFF + +{-# SPECIALIZE ch :: Word64 -> Word64 -> Word64 -> Word64 #-} +ch :: Bits a => a -> a -> a -> a +ch x y z = (x .&. y) `xor` (complement x .&. z) + +{-# SPECIALIZE maj :: Word64 -> Word64 -> Word64 -> Word64 #-} +maj :: Bits a => a -> a -> a -> a +maj x y z = (x .&. (y .|. z)) .|. (y .&. z) +-- note: +-- the original functions is (x & y) ^ (x & z) ^ (y & z) +-- if you fire off truth tables, this is equivalent to +-- (x & y) | (x & z) | (y & z) +-- which you can the use distribution on: +-- (x & (y | z)) | (y & z) +-- which saves us one operation. + +bsig512_0 :: Word64 -> Word64 +bsig512_0 x = rotate x (-28) `xor` rotate x (-34) `xor` rotate x (-39) + +bsig512_1 :: Word64 -> Word64 +bsig512_1 x = rotate x (-14) `xor` rotate x (-18) `xor` rotate x (-41) + +lsig512_0 :: Word64 -> Word64 +lsig512_0 x = rotate x (-1) `xor` rotate x (-8) `xor` shiftR x 7 + +lsig512_1 :: Word64 -> Word64 +lsig512_1 x = rotate x (-19) `xor` rotate x (-61) `xor` shiftR x 6 + +data SHA512Sched = SHA512Sched !Word64 !Word64 !Word64 !Word64 !Word64 -- 0- 4 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 5- 9 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 10-14 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 15-19 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 20-24 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 25-29 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 30-34 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 35-39 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 40-44 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 45-49 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 50-54 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 55-59 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 60-64 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 65-69 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 70-74 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 75-79 + +getSHA512Sched :: Get SHA512Sched +getSHA512Sched = do + w00 <- getWord64be + w01 <- getWord64be + w02 <- getWord64be + w03 <- getWord64be + w04 <- getWord64be + w05 <- getWord64be + w06 <- getWord64be + w07 <- getWord64be + w08 <- getWord64be + w09 <- getWord64be + w10 <- getWord64be + w11 <- getWord64be + w12 <- getWord64be + w13 <- getWord64be + w14 <- getWord64be + w15 <- getWord64be + let w16 = lsig512_1 w14 + w09 + lsig512_0 w01 + w00 + w17 = lsig512_1 w15 + w10 + lsig512_0 w02 + w01 + w18 = lsig512_1 w16 + w11 + lsig512_0 w03 + w02 + w19 = lsig512_1 w17 + w12 + lsig512_0 w04 + w03 + w20 = lsig512_1 w18 + w13 + lsig512_0 w05 + w04 + w21 = lsig512_1 w19 + w14 + lsig512_0 w06 + w05 + w22 = lsig512_1 w20 + w15 + lsig512_0 w07 + w06 + w23 = lsig512_1 w21 + w16 + lsig512_0 w08 + w07 + w24 = lsig512_1 w22 + w17 + lsig512_0 w09 + w08 + w25 = lsig512_1 w23 + w18 + lsig512_0 w10 + w09 + w26 = lsig512_1 w24 + w19 + lsig512_0 w11 + w10 + w27 = lsig512_1 w25 + w20 + lsig512_0 w12 + w11 + w28 = lsig512_1 w26 + w21 + lsig512_0 w13 + w12 + w29 = lsig512_1 w27 + w22 + lsig512_0 w14 + w13 + w30 = lsig512_1 w28 + w23 + lsig512_0 w15 + w14 + w31 = lsig512_1 w29 + w24 + lsig512_0 w16 + w15 + w32 = lsig512_1 w30 + w25 + lsig512_0 w17 + w16 + w33 = lsig512_1 w31 + w26 + lsig512_0 w18 + w17 + w34 = lsig512_1 w32 + w27 + lsig512_0 w19 + w18 + w35 = lsig512_1 w33 + w28 + lsig512_0 w20 + w19 + w36 = lsig512_1 w34 + w29 + lsig512_0 w21 + w20 + w37 = lsig512_1 w35 + w30 + lsig512_0 w22 + w21 + w38 = lsig512_1 w36 + w31 + lsig512_0 w23 + w22 + w39 = lsig512_1 w37 + w32 + lsig512_0 w24 + w23 + w40 = lsig512_1 w38 + w33 + lsig512_0 w25 + w24 + w41 = lsig512_1 w39 + w34 + lsig512_0 w26 + w25 + w42 = lsig512_1 w40 + w35 + lsig512_0 w27 + w26 + w43 = lsig512_1 w41 + w36 + lsig512_0 w28 + w27 + w44 = lsig512_1 w42 + w37 + lsig512_0 w29 + w28 + w45 = lsig512_1 w43 + w38 + lsig512_0 w30 + w29 + w46 = lsig512_1 w44 + w39 + lsig512_0 w31 + w30 + w47 = lsig512_1 w45 + w40 + lsig512_0 w32 + w31 + w48 = lsig512_1 w46 + w41 + lsig512_0 w33 + w32 + w49 = lsig512_1 w47 + w42 + lsig512_0 w34 + w33 + w50 = lsig512_1 w48 + w43 + lsig512_0 w35 + w34 + w51 = lsig512_1 w49 + w44 + lsig512_0 w36 + w35 + w52 = lsig512_1 w50 + w45 + lsig512_0 w37 + w36 + w53 = lsig512_1 w51 + w46 + lsig512_0 w38 + w37 + w54 = lsig512_1 w52 + w47 + lsig512_0 w39 + w38 + w55 = lsig512_1 w53 + w48 + lsig512_0 w40 + w39 + w56 = lsig512_1 w54 + w49 + lsig512_0 w41 + w40 + w57 = lsig512_1 w55 + w50 + lsig512_0 w42 + w41 + w58 = lsig512_1 w56 + w51 + lsig512_0 w43 + w42 + w59 = lsig512_1 w57 + w52 + lsig512_0 w44 + w43 + w60 = lsig512_1 w58 + w53 + lsig512_0 w45 + w44 + w61 = lsig512_1 w59 + w54 + lsig512_0 w46 + w45 + w62 = lsig512_1 w60 + w55 + lsig512_0 w47 + w46 + w63 = lsig512_1 w61 + w56 + lsig512_0 w48 + w47 + w64 = lsig512_1 w62 + w57 + lsig512_0 w49 + w48 + w65 = lsig512_1 w63 + w58 + lsig512_0 w50 + w49 + w66 = lsig512_1 w64 + w59 + lsig512_0 w51 + w50 + w67 = lsig512_1 w65 + w60 + lsig512_0 w52 + w51 + w68 = lsig512_1 w66 + w61 + lsig512_0 w53 + w52 + w69 = lsig512_1 w67 + w62 + lsig512_0 w54 + w53 + w70 = lsig512_1 w68 + w63 + lsig512_0 w55 + w54 + w71 = lsig512_1 w69 + w64 + lsig512_0 w56 + w55 + w72 = lsig512_1 w70 + w65 + lsig512_0 w57 + w56 + w73 = lsig512_1 w71 + w66 + lsig512_0 w58 + w57 + w74 = lsig512_1 w72 + w67 + lsig512_0 w59 + w58 + w75 = lsig512_1 w73 + w68 + lsig512_0 w60 + w59 + w76 = lsig512_1 w74 + w69 + lsig512_0 w61 + w60 + w77 = lsig512_1 w75 + w70 + lsig512_0 w62 + w61 + w78 = lsig512_1 w76 + w71 + lsig512_0 w63 + w62 + w79 = lsig512_1 w77 + w72 + lsig512_0 w64 + w63 + return $ SHA512Sched w00 w01 w02 w03 w04 w05 w06 w07 w08 w09 + w10 w11 w12 w13 w14 w15 w16 w17 w18 w19 + w20 w21 w22 w23 w24 w25 w26 w27 w28 w29 + w30 w31 w32 w33 w34 w35 w36 w37 w38 w39 + w40 w41 w42 w43 w44 w45 w46 w47 w48 w49 + w50 w51 w52 w53 w54 w55 w56 w57 w58 w59 + w60 w61 w62 w63 w64 w65 w66 w67 w68 w69 + w70 w71 w72 w73 w74 w75 w76 w77 w78 w79 + +processSHA512Block :: SHA512State -> Get SHA512State +processSHA512Block !s00@(SHA512S a00 b00 c00 d00 e00 f00 g00 h00) = do + (SHA512Sched w00 w01 w02 w03 w04 w05 w06 w07 w08 w09 + w10 w11 w12 w13 w14 w15 w16 w17 w18 w19 + w20 w21 w22 w23 w24 w25 w26 w27 w28 w29 + w30 w31 w32 w33 w34 w35 w36 w37 w38 w39 + w40 w41 w42 w43 w44 w45 w46 w47 w48 w49 + w50 w51 w52 w53 w54 w55 w56 w57 w58 w59 + w60 w61 w62 w63 w64 w65 w66 w67 w68 w69 + w70 w71 w72 w73 w74 w75 w76 w77 w78 w79) <- getSHA512Sched + let s01 = step512 s00 0x428a2f98d728ae22 w00 + s02 = step512 s01 0x7137449123ef65cd w01 + s03 = step512 s02 0xb5c0fbcfec4d3b2f w02 + s04 = step512 s03 0xe9b5dba58189dbbc w03 + s05 = step512 s04 0x3956c25bf348b538 w04 + s06 = step512 s05 0x59f111f1b605d019 w05 + s07 = step512 s06 0x923f82a4af194f9b w06 + s08 = step512 s07 0xab1c5ed5da6d8118 w07 + s09 = step512 s08 0xd807aa98a3030242 w08 + s10 = step512 s09 0x12835b0145706fbe w09 + s11 = step512 s10 0x243185be4ee4b28c w10 + s12 = step512 s11 0x550c7dc3d5ffb4e2 w11 + s13 = step512 s12 0x72be5d74f27b896f w12 + s14 = step512 s13 0x80deb1fe3b1696b1 w13 + s15 = step512 s14 0x9bdc06a725c71235 w14 + s16 = step512 s15 0xc19bf174cf692694 w15 + s17 = step512 s16 0xe49b69c19ef14ad2 w16 + s18 = step512 s17 0xefbe4786384f25e3 w17 + s19 = step512 s18 0x0fc19dc68b8cd5b5 w18 + s20 = step512 s19 0x240ca1cc77ac9c65 w19 + s21 = step512 s20 0x2de92c6f592b0275 w20 + s22 = step512 s21 0x4a7484aa6ea6e483 w21 + s23 = step512 s22 0x5cb0a9dcbd41fbd4 w22 + s24 = step512 s23 0x76f988da831153b5 w23 + s25 = step512 s24 0x983e5152ee66dfab w24 + s26 = step512 s25 0xa831c66d2db43210 w25 + s27 = step512 s26 0xb00327c898fb213f w26 + s28 = step512 s27 0xbf597fc7beef0ee4 w27 + s29 = step512 s28 0xc6e00bf33da88fc2 w28 + s30 = step512 s29 0xd5a79147930aa725 w29 + s31 = step512 s30 0x06ca6351e003826f w30 + s32 = step512 s31 0x142929670a0e6e70 w31 + s33 = step512 s32 0x27b70a8546d22ffc w32 + s34 = step512 s33 0x2e1b21385c26c926 w33 + s35 = step512 s34 0x4d2c6dfc5ac42aed w34 + s36 = step512 s35 0x53380d139d95b3df w35 + s37 = step512 s36 0x650a73548baf63de w36 + s38 = step512 s37 0x766a0abb3c77b2a8 w37 + s39 = step512 s38 0x81c2c92e47edaee6 w38 + s40 = step512 s39 0x92722c851482353b w39 + s41 = step512 s40 0xa2bfe8a14cf10364 w40 + s42 = step512 s41 0xa81a664bbc423001 w41 + s43 = step512 s42 0xc24b8b70d0f89791 w42 + s44 = step512 s43 0xc76c51a30654be30 w43 + s45 = step512 s44 0xd192e819d6ef5218 w44 + s46 = step512 s45 0xd69906245565a910 w45 + s47 = step512 s46 0xf40e35855771202a w46 + s48 = step512 s47 0x106aa07032bbd1b8 w47 + s49 = step512 s48 0x19a4c116b8d2d0c8 w48 + s50 = step512 s49 0x1e376c085141ab53 w49 + s51 = step512 s50 0x2748774cdf8eeb99 w50 + s52 = step512 s51 0x34b0bcb5e19b48a8 w51 + s53 = step512 s52 0x391c0cb3c5c95a63 w52 + s54 = step512 s53 0x4ed8aa4ae3418acb w53 + s55 = step512 s54 0x5b9cca4f7763e373 w54 + s56 = step512 s55 0x682e6ff3d6b2b8a3 w55 + s57 = step512 s56 0x748f82ee5defb2fc w56 + s58 = step512 s57 0x78a5636f43172f60 w57 + s59 = step512 s58 0x84c87814a1f0ab72 w58 + s60 = step512 s59 0x8cc702081a6439ec w59 + s61 = step512 s60 0x90befffa23631e28 w60 + s62 = step512 s61 0xa4506cebde82bde9 w61 + s63 = step512 s62 0xbef9a3f7b2c67915 w62 + s64 = step512 s63 0xc67178f2e372532b w63 + s65 = step512 s64 0xca273eceea26619c w64 + s66 = step512 s65 0xd186b8c721c0c207 w65 + s67 = step512 s66 0xeada7dd6cde0eb1e w66 + s68 = step512 s67 0xf57d4f7fee6ed178 w67 + s69 = step512 s68 0x06f067aa72176fba w68 + s70 = step512 s69 0x0a637dc5a2c898a6 w69 + s71 = step512 s70 0x113f9804bef90dae w70 + s72 = step512 s71 0x1b710b35131c471b w71 + s73 = step512 s72 0x28db77f523047d84 w72 + s74 = step512 s73 0x32caab7b40c72493 w73 + s75 = step512 s74 0x3c9ebe0a15c9bebc w74 + s76 = step512 s75 0x431d67c49c100d4c w75 + s77 = step512 s76 0x4cc5d4becb3e42b6 w76 + s78 = step512 s77 0x597f299cfc657e2a w77 + s79 = step512 s78 0x5fcb6fab3ad6faec w78 + s80 = step512 s79 0x6c44198c4a475817 w79 + SHA512S a80 b80 c80 d80 e80 f80 g80 h80 = s80 + return $ SHA512S (a00 + a80) (b00 + b80) (c00 + c80) (d00 + d80) + (e00 + e80) (f00 + f80) (g00 + g80) (h00 + h80) + +{-# INLINE step512 #-} +step512 :: SHA512State -> Word64 -> Word64 -> SHA512State +step512 !(SHA512S a b c d e f g h) k w = SHA512S a' b' c' d' e' f' g' h' + where + t1 = h + bsig512_1 e + ch e f g + k + w + t2 = bsig512_0 a + maj a b c + h' = g + g' = f + f' = e + e' = d + t1 + d' = c + c' = b + b' = a + a' = t1 + t2 + +runSHA :: a -> (a -> Get a) -> ByteString -> a +runSHA s nextChunk input = runGet (getAll s) input + where + getAll s_in = do + done <- isEmpty + if done + then return s_in + else nextChunk s_in >>= getAll + +sha512 :: ByteString -> Digest SHA512State +sha512 bs_in = Digest bs_out + where + bs_pad = padSHA512 bs_in + fstate = runSHA initialSHA512State processSHA512Block bs_pad + bs_out = runPut $ synthesizeSHA512 fstate + +sha512_spec_tests :: [(String, String)] +sha512_spec_tests = + [("abc", + "ddaf35a193617abacc417349ae20413112e6fa4e89a97ea20a9eeee64b55d39a" ++ + "2192992a274fc1a836ba3c23a3feebbd454d4423643ce80e2a9ac94fa54ca49f"), + ("abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmn" ++ + "hijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu", + "8e959b75dae313da8cf4f72814fc143f8f7779c6eb9f7fa17299aeadb6889018" ++ + "501d289e4900f7e4331b99dec4b5433ac7d329eeb6dd26545e96e55b874be909"), + (replicate 1000000 'a', + "e718483d0ce769644e2e42c7bc15b4638e1f98b13b2044285632a803afa973eb" ++ + "de0ff244877ea60a4cb0432ce577c31beb009c5c2c49aa2e4eadb217ad8cc09b")] + +showDigest :: Digest t -> String +showDigest (Digest bs) = showDigestBS bs + +-- |Prints out a bytestring in hexadecimal. Just for convenience. +showDigestBS :: ByteString -> String +showDigestBS bs = foldr paddedShowHex [] (BS.unpack bs) + where + paddedShowHex x xs = intToDigit (fromIntegral (x `shiftR` 4)) + : intToDigit (fromIntegral (x .&. 0xf)) + : xs + +main :: IO () +main = do + sequence_ + [ unless (digest == expected) + $ fail $ "failed: " ++ expected ++ " /= " ++ digest + | (str, expected) <- sha512_spec_tests + , let digest = showDigest (sha512 $ BSC.pack str) + ] ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -219,3 +219,4 @@ test('CallConv', [when(unregisterised(), skip), when(arch('x86_64'), extra_hc_opts('CallConv_x86_64.s')), when(arch('aarch64'), extra_hc_opts('CallConv_aarch64.s'))], compile_and_run, ['']) +test('T22798', normal, compile_and_run, ['-fregs-graph']) ===================================== testsuite/tests/ghci/T16392/T16392.script ===================================== @@ -1,5 +1,7 @@ :set -fobject-code +import System.Mem :load A.hs c_two caf +performMajorGC :load A.hs c_two caf ===================================== testsuite/tests/ghci/linking/dyn/Makefile ===================================== @@ -74,7 +74,7 @@ compile_libAB_dyn: '$(TEST_HC)' $(MY_TEST_HC_OPTS) -odir "bin_dyn" -shared B.c -o "bin_dyn/$(call DLL,B)" -lA -L"./bin_dyn" rm -f bin_dyn/*.a '$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -v0 -o "bin_dyn/$(call EXE,T10955dyn)" -L./bin_dyn -lB -lA T10955dyn.hs -v0 - LD_LIBRARY_PATH=./bin_dyn ./bin_dyn/$(call EXE,T10955dyn) + DYLD_LIBRARY_PATH=./bin_dyn LD_LIBRARY_PATH=./bin_dyn ./bin_dyn/$(call EXE,T10955dyn) .PHONY: compile_libAS_impl_gcc compile_libAS_impl_gcc: ===================================== testsuite/tests/rts/T18623/all.T ===================================== @@ -5,7 +5,10 @@ test('T18623', # This keeps failing on aarch64-linux for reasons that are not # fully clear. Maybe it needs a higher limit due to LLMV? when(arch('aarch64'), skip), + # Recent versions of osx report an error when running `ulimit -v` + when(opsys('darwin'), skip), + when(arch('powerpc64le'), skip), cmd_prefix('ulimit -v ' + str(1024 ** 2) + ' && '), ignore_stdout], run_command, - ['{compiler} --version']) \ No newline at end of file + ['{compiler} --version']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/86e659f1fe85a4e6d46a439efb664b9dac152e38...bcb79aeadf0af55e4415896b70c893c8ff4ca87f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/86e659f1fe85a4e6d46a439efb664b9dac152e38...bcb79aeadf0af55e4415896b70c893c8ff4ca87f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 20:39:22 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Thu, 02 Feb 2023 15:39:22 -0500 Subject: [Git][ghc/ghc][wip/9.2.6-backports] 23 commits: Bump bytestring submodule to 0.11.4.0 Message-ID: <63dc1f7ac9d50_1108fe54ddcd026916e@gitlab.mail> Zubin pushed to branch wip/9.2.6-backports at Glasgow Haskell Compiler / GHC Commits: 9984953a by Zubin Duggal at 2023-02-03T02:07:47+05:30 Bump bytestring submodule to 0.11.4.0 - - - - - 0aaf3f32 by Andreas Klebinger at 2023-02-03T02:08:18+05:30 Only gc sparks locally when we can ensure marking is done. When performing GC without work stealing there was no guarantee that spark pruning was happening after marking of the sparks. This could cause us to GC live sparks under certain circumstances. Fixes #22528. (cherry picked from commit a1491c8791c57a64d94bc08d639d585815c8d4e2) - - - - - 932e254e by Ian-Woo Kim at 2023-02-03T02:08:18+05:30 Truncate eventlog event for large payload (#20221) RTS eventlog events for postCapsetVecEvent are truncated if payload is larger than EVENT_PAYLOAD_SIZE_MAX Previously, postCapsetVecEvent records eventlog event with payload of variable size larger than EVENT_PAYLOAD_SIZE_MAX (2^16) without any validation, resulting in corrupted data. For example, this happens when a Haskell binary is invoked with very long command line arguments exceeding 2^16 bytes (see #20221). Now we check the size of accumulated payload messages incrementally, and truncate the message just before the payload size exceeds EVENT_PAYLOAD_SIZE_MAX. RTS will warn the user with a message showing how many arguments are truncated. (cherry picked from commit 2057c77d08cb8422857d182a3691f98dccd0c7d6) - - - - - f1673757 by Simon Peyton Jones at 2023-02-03T02:08:18+05:30 Make FloatIn robust to shadowing This MR fixes #22622. See the new Note [Shadowing and name capture] I did a bit of refactoring in sepBindsByDropPoint too. The bug doesn't manifest in HEAD, but it did show up in 9.4, so we should backport this patch to 9.4 (cherry picked from commit 6206cb9287f3f6e70c669660a646a65274870d2b) - - - - - 6908314e by Ben Gamari at 2023-02-03T02:08:18+05:30 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. (cherry picked from commit f891a442046d8a5ebf4d4777847880ce06752b18) - - - - - a71b639a by Ben Gamari at 2023-02-03T02:08:18+05:30 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. (cherry picked from commit b13c6ea5d4b64841164f8cc58d6c6f3de390f2ed) - - - - - baa8bdde by Oleg Grenrus at 2023-02-03T02:08:18+05:30 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general (cherry picked from commit 1b812b6973a25cb1962e2fc543d2c4ed3cf31f3c) - - - - - 25d165de by Zubin Duggal at 2023-02-03T02:08:18+05:30 Document #22255 and #22468 in bugs.rst - - - - - 654ffd68 by Simon Peyton Jones at 2023-02-03T02:08:18+05:30 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 (cherry picked from commit 3d55d8ab51ece43c51055c43c9e7aba77cce46c0) - - - - - 89c5df26 by Simon Peyton Jones at 2023-02-03T02:08:19+05:30 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. (cherry picked from commit e193e53790dd5886feea3cf4c9c17625d188291b) - - - - - ceae28e3 by Sebastian Graf at 2023-02-03T02:08:19+05:30 DmdAnal: Don't panic in addCaseBndrDmd (#22039) Rather conservatively return Top. See Note [Untyped demand on case-alternative binders]. I also factored `addCaseBndrDmd` into two separate functions `scrutSubDmd` and `fieldBndrDmds`. Fixes #22039. (cherry picked from commit d2be80fd9b222963e8dd09a30f78c106e00da7f9) - - - - - c3790f06 by Matthew Pickering at 2023-02-03T02:08:19+05:30 ApplicativeDo: Set pattern location before running exhaustiveness checker This improves the error messages of the exhaustiveness checker when checking statements which have been moved around with ApplicativeDo. Before: Test.hs:2:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 2 | let x = () | ^^^^^^^^^^ After: Test.hs:4:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 4 | ~(Just res1) <- seq x (pure $ Nothing @()) | Fixes #22483 (cherry picked from commit 74c767df770766d8d52e87b9ff7da10f94620a91) (cherry picked from commit 51c6051bcc405bc1dbddd450ade949acd70db6b8) - - - - - ee071d6e by Andreas Klebinger at 2023-02-03T02:08:19+05:30 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- (cherry picked from commit 08ba87200ff068aa37cac082e61ee7e2d534daf5) - - - - - b9cf7a82 by Matthew Pickering at 2023-02-03T02:08:19+05:30 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s (cherry picked from commit a960ca817d6ad0109ea6edda50da3902cc538e86) - - - - - 642997a3 by Matthew Pickering at 2023-02-03T02:08:19+05:30 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. (cherry picked from commit 734847108420cf826a807c30ad54651659cf3a08) - - - - - e0c82228 by Matthew Pickering at 2023-02-03T02:08:19+05:30 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes (cherry picked from commit 8c0ea25fb4a27d4729aabf73f4c00b912bb0c58d) - - - - - 5365c2f6 by Cheng Shao at 2023-02-03T02:08:19+05:30 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. (cherry picked from commit c45a5fffef2c76efbf5d3a009c3f6d0244a63f0d) - - - - - ce46685e by Ben Gamari at 2023-02-03T02:08:19+05:30 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. (cherry picked from commit be417a47c7695998dea0adc05489a7b8838a78b6) - - - - - e5b09e53 by Ben Gamari at 2023-02-03T02:08:19+05:30 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. (cherry picked from commit 30989d137b8f3a8fddbfd116e04b48f23c24f86c) - - - - - edb52c77 by Ben Gamari at 2023-02-03T02:08:19+05:30 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. (cherry picked from commit 7566fd9de38c67360c090f828923d41587af519c) - - - - - 7d334e50 by Ben Gamari at 2023-02-03T02:08:19+05:30 testsuite: Add regression test for #22798 (cherry picked from commit 2cb500a5ee1a31dfe1a2cdd71f175442026eb082) - - - - - 05356dc1 by Zubin Duggal at 2023-02-03T02:08:19+05:30 hadrian: enable -haddock in perf flavour (#22734) - - - - - 42231557 by Zubin Duggal at 2023-02-03T02:08:19+05:30 Fix warnings - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/HsToCore/Expr.hs - compiler/cbits/keepCAFsForGHCi.c - compiler/ghc.mk - configure.ac - docs/users_guide/bugs.rst - hadrian/src/Settings/Flavours/Performance.hs - libraries/bytestring - libraries/ghc-bignum/gmp/gmp-tarballs - + m4/fp_ld_no_fixup_chains.m4 - rts/Sparks.c - rts/eventlog/EventLog.c - rts/sm/GC.c - + testsuite/tests/ado/T22483.hs - + testsuite/tests/ado/T22483.stderr - testsuite/tests/ado/all.T - + testsuite/tests/codeGen/should_run/T22798.hs - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/ghci/T16392/T16392.script - testsuite/tests/ghci/linking/dyn/Makefile - testsuite/tests/rts/T18623/all.T - + testsuite/tests/safeHaskell/warnings/Makefile - + testsuite/tests/safeHaskell/warnings/T22728.hs - + testsuite/tests/safeHaskell/warnings/T22728.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bcb79aeadf0af55e4415896b70c893c8ff4ca87f...422315577c379bddfc5bb25c42945e6c87f107ad -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bcb79aeadf0af55e4415896b70c893c8ff4ca87f...422315577c379bddfc5bb25c42945e6c87f107ad You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 20:47:23 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Thu, 02 Feb 2023 15:47:23 -0500 Subject: [Git][ghc/ghc][wip/9.2.6-backports] 10 commits: ghc-the-library: Retain cafs in both static in dynamic builds. Message-ID: <63dc215bcad8c_1108fe5265c269845@gitlab.mail> Zubin pushed to branch wip/9.2.6-backports at Glasgow Haskell Compiler / GHC Commits: 2b970eb4 by Andreas Klebinger at 2023-02-03T02:16:18+05:30 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- (cherry picked from commit 08ba87200ff068aa37cac082e61ee7e2d534daf5) - - - - - 2b0eca3f by Matthew Pickering at 2023-02-03T02:16:19+05:30 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s (cherry picked from commit a960ca817d6ad0109ea6edda50da3902cc538e86) - - - - - faefebc2 by Matthew Pickering at 2023-02-03T02:16:19+05:30 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. (cherry picked from commit 734847108420cf826a807c30ad54651659cf3a08) - - - - - ec2541c9 by Matthew Pickering at 2023-02-03T02:16:19+05:30 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes (cherry picked from commit 8c0ea25fb4a27d4729aabf73f4c00b912bb0c58d) - - - - - 61afcfdc by Cheng Shao at 2023-02-03T02:16:19+05:30 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. (cherry picked from commit c45a5fffef2c76efbf5d3a009c3f6d0244a63f0d) - - - - - d5818b42 by Ben Gamari at 2023-02-03T02:16:19+05:30 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. (cherry picked from commit be417a47c7695998dea0adc05489a7b8838a78b6) - - - - - d59dd224 by Ben Gamari at 2023-02-03T02:16:19+05:30 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. (cherry picked from commit 30989d137b8f3a8fddbfd116e04b48f23c24f86c) - - - - - b158a225 by Ben Gamari at 2023-02-03T02:16:19+05:30 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. (cherry picked from commit 7566fd9de38c67360c090f828923d41587af519c) - - - - - 9e7dd74f by Ben Gamari at 2023-02-03T02:16:19+05:30 testsuite: Add regression test for #22798 (cherry picked from commit 2cb500a5ee1a31dfe1a2cdd71f175442026eb082) - - - - - 03e3451e by Zubin Duggal at 2023-02-03T02:16:19+05:30 hadrian: enable -haddock in perf flavour (#22734) - - - - - 13 changed files: - compiler/GHC.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/cbits/keepCAFsForGHCi.c - compiler/ghc.mk - configure.ac - hadrian/src/Settings/Flavours/Performance.hs - + m4/fp_ld_no_fixup_chains.m4 - + testsuite/tests/codeGen/should_run/T22798.hs - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/ghci/T16392/T16392.script - testsuite/tests/ghci/linking/dyn/Makefile - testsuite/tests/rts/T18623/all.T Changes: ===================================== compiler/GHC.hs ===================================== @@ -554,7 +554,12 @@ withCleanupSession ghc = ghc `MC.finally` cleanup initGhcMonad :: GhcMonad m => Maybe FilePath -> m () initGhcMonad mb_top_dir - = do { env <- liftIO $ + = do { -- The call to c_keepCAFsForGHCi must not be optimized away. Even in non-debug builds. + -- So we can't use assertM here. + -- See Note [keepCAFsForGHCi] in keepCAFsForGHCi.c for details about why. + !keep_cafs <- liftIO $ c_keepCAFsForGHCi + ; MASSERT( keep_cafs ) + ; env <- liftIO $ do { top_dir <- findTopDir mb_top_dir ; mySettings <- initSysTools top_dir ; myLlvmConfig <- lazyInitLlvmConfig top_dir @@ -600,7 +605,6 @@ checkBrokenTablesNextToCode' logger dflags arch = platformArch platform tablesNextToCode = platformTablesNextToCode platform - -- %************************************************************************ -- %* * -- Flags & settings @@ -1931,3 +1935,5 @@ instance Exception GhcApiError mkApiErr :: DynFlags -> SDoc -> GhcApiError mkApiErr dflags msg = GhcApiError (showSDoc dflags msg) +foreign import ccall unsafe "keepCAFsForGHCi" + c_keepCAFsForGHCi :: IO Bool ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -73,6 +73,11 @@ instance Outputable RegUsage where regUsageOfInstr :: Platform -> Instr -> RegUsage regUsageOfInstr platform instr = case instr of ANN _ i -> regUsageOfInstr platform i + COMMENT{} -> usage ([], []) + PUSH_STACK_FRAME -> usage ([], []) + POP_STACK_FRAME -> usage ([], []) + DELTA{} -> usage ([], []) + -- 1. Arithmetic Instructions ------------------------------------------------ ADD dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) CMN l r -> usage (regOp l ++ regOp r, []) @@ -137,7 +142,7 @@ regUsageOfInstr platform instr = case instr of FCVTZS dst src -> usage (regOp src, regOp dst) FABS dst src -> usage (regOp src, regOp dst) - _ -> panic "regUsageOfInstr" + _ -> panic $ "regUsageOfInstr: " ++ instrCon instr where -- filtering the usage is necessary, otherwise the register @@ -203,7 +208,11 @@ callerSavedRegisters patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr patchRegsOfInstr instr env = case instr of -- 0. Meta Instructions - ANN d i -> ANN d (patchRegsOfInstr i env) + ANN d i -> ANN d (patchRegsOfInstr i env) + COMMENT{} -> instr + PUSH_STACK_FRAME -> instr + POP_STACK_FRAME -> instr + DELTA{} -> instr -- 1. Arithmetic Instructions ---------------------------------------------- ADD o1 o2 o3 -> ADD (patchOp o1) (patchOp o2) (patchOp o3) CMN o1 o2 -> CMN (patchOp o1) (patchOp o2) @@ -269,8 +278,7 @@ patchRegsOfInstr instr env = case instr of SCVTF o1 o2 -> SCVTF (patchOp o1) (patchOp o2) FCVTZS o1 o2 -> FCVTZS (patchOp o1) (patchOp o2) FABS o1 o2 -> FABS (patchOp o1) (patchOp o2) - - _ -> pprPanic "patchRegsOfInstr" (text $ show instr) + _ -> panic $ "patchRegsOfInstr: " ++ instrCon instr where patchOp :: Operand -> Operand patchOp (OpReg w r) = OpReg w (env r) @@ -326,7 +334,7 @@ patchJumpInstr instr patchF B (TBlock bid) -> B (TBlock (patchF bid)) BL (TBlock bid) ps rs -> BL (TBlock (patchF bid)) ps rs BCOND c (TBlock bid) -> BCOND c (TBlock (patchF bid)) - _ -> pprPanic "patchJumpInstr" (text $ show instr) + _ -> panic $ "patchJumpInstr: " ++ instrCon instr -- ----------------------------------------------------------------------------- -- Note [Spills and Reloads] @@ -638,10 +646,69 @@ data Instr -- Float ABSolute value | FABS Operand Operand -instance Show Instr where - show (LDR _f o1 o2) = "LDR " ++ show o1 ++ ", " ++ show o2 - show (MOV o1 o2) = "MOV " ++ show o1 ++ ", " ++ show o2 - show _ = "missing" +instrCon :: Instr -> String +instrCon i = + case i of + COMMENT{} -> "COMMENT" + MULTILINE_COMMENT{} -> "COMMENT" + ANN{} -> "ANN" + LOCATION{} -> "LOCATION" + LDATA{} -> "LDATA" + NEWBLOCK{} -> "NEWBLOCK" + DELTA{} -> "DELTA" + SXTB{} -> "SXTB" + UXTB{} -> "UXTB" + SXTH{} -> "SXTH" + UXTH{} -> "UXTH" + PUSH_STACK_FRAME{} -> "PUSH_STACK_FRAME" + POP_STACK_FRAME{} -> "POP_STACK_FRAME" + ADD{} -> "ADD" + CMN{} -> "CMN" + CMP{} -> "CMP" + MSUB{} -> "MSUB" + MUL{} -> "MUL" + NEG{} -> "NEG" + SDIV{} -> "SDIV" + SMULH{} -> "SMULH" + SMULL{} -> "SMULL" + SUB{} -> "SUB" + UDIV{} -> "UDIV" + SBFM{} -> "SBFM" + UBFM{} -> "UBFM" + SBFX{} -> "SBFX" + UBFX{} -> "UBFX" + AND{} -> "AND" + ANDS{} -> "ANDS" + ASR{} -> "ASR" + BIC{} -> "BIC" + BICS{} -> "BICS" + EON{} -> "EON" + EOR{} -> "EOR" + LSL{} -> "LSL" + LSR{} -> "LSR" + MOV{} -> "MOV" + MOVK{} -> "MOVK" + MVN{} -> "MVN" + ORN{} -> "ORN" + ORR{} -> "ORR" + ROR{} -> "ROR" + TST{} -> "TST" + STR{} -> "STR" + LDR{} -> "LDR" + STP{} -> "STP" + LDP{} -> "LDP" + CSET{} -> "CSET" + CBZ{} -> "CBZ" + CBNZ{} -> "CBNZ" + J{} -> "J" + B{} -> "B" + BL{} -> "BL" + BCOND{} -> "BCOND" + DMBSY{} -> "DMBSY" + FCVT{} -> "FCVT" + SCVTF{} -> "SCVTF" + FCVTZS{} -> "FCVTZS" + FABS{} -> "FABS" data Target = TBlock BlockId @@ -769,11 +836,11 @@ opRegUExt W64 r = OpRegExt W64 r EUXTX 0 opRegUExt W32 r = OpRegExt W32 r EUXTW 0 opRegUExt W16 r = OpRegExt W16 r EUXTH 0 opRegUExt W8 r = OpRegExt W8 r EUXTB 0 -opRegUExt w _r = pprPanic "opRegUExt" (text $ show w) +opRegUExt w _r = pprPanic "opRegUExt" (ppr w) opRegSExt :: Width -> Reg -> Operand opRegSExt W64 r = OpRegExt W64 r ESXTX 0 opRegSExt W32 r = OpRegExt W32 r ESXTW 0 opRegSExt W16 r = OpRegExt W16 r ESXTH 0 opRegSExt W8 r = OpRegExt W8 r ESXTB 0 -opRegSExt w _r = pprPanic "opRegSExt" (text $ show w) +opRegSExt w _r = pprPanic "opRegSExt" (ppr w) ===================================== compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs ===================================== @@ -115,10 +115,8 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcInteger conflicts excl ArchSPARC64 -> panic "trivColorable ArchSPARC64" ArchPPC_64 _ -> 15 ArchARM _ _ _ -> panic "trivColorable ArchARM" - -- We should be able to allocate *a lot* more in princple. - -- essentially all 32 - SP, so 31, we'd trash the link reg - -- as well as the platform and all others though. - ArchAArch64 -> 18 + -- N.B. x18 is reserved by the platform on AArch64/Darwin + ArchAArch64 -> 17 ArchAlpha -> panic "trivColorable ArchAlpha" ArchMipseb -> panic "trivColorable ArchMipseb" ArchMipsel -> panic "trivColorable ArchMipsel" ===================================== compiler/cbits/keepCAFsForGHCi.c ===================================== @@ -1,15 +1,35 @@ #include +#include +// Note [keepCAFsForGHCi] +// ~~~~~~~~~~~~~~~~~~~~~~ // This file is only included in the dynamic library. // It contains an __attribute__((constructor)) function (run prior to main()) // which sets the keepCAFs flag in the RTS, before any Haskell code is run. // This is required so that GHCi can use dynamic libraries instead of HSxyz.o // files. +// +// For static builds we have to guarantee that the linker loads this object file +// to ensure the constructor gets run and not discarded. If the object is part of +// an archive and not otherwise referenced the linker would ignore the object. +// To avoid this: +// * When initializing a GHC session in initGhcMonad we assert keeping cafs has been +// enabled by calling keepCAFsForGHCi. +// * This causes the GHC module from the ghc package to carry a reference to this object +// file. +// * Which in turn ensures the linker doesn't discard this object file, causing +// the constructor to be run, allowing the assertion to succeed in the first place +// as keepCAFs will have been set already during initialization of constructors. -static void keepCAFsForGHCi(void) __attribute__((constructor)); -static void keepCAFsForGHCi(void) + +bool keepCAFsForGHCi(void) __attribute__((constructor)); + +bool keepCAFsForGHCi(void) { - keepCAFs = 1; + bool was_set = keepCAFs; + setKeepCAFs(); + return was_set; } + ===================================== compiler/ghc.mk ===================================== @@ -288,20 +288,6 @@ $(eval $(call build-package,compiler,stage1,0)) $(eval $(call build-package,compiler,stage2,1)) $(eval $(call build-package,compiler,stage3,2)) -# We only want to turn keepCAFs on if we will be loading dynamic -# Haskell libraries with GHCi. We therefore filter the object file -# out for non-dynamic ways. -define keepCAFsForGHCiDynOnly -# $1 = stage -# $2 = way -ifeq "$$(findstring dyn, $2)" "" -compiler_stage$1_$2_C_OBJS := $$(filter-out %/keepCAFsForGHCi.$$($2_osuf),$$(compiler_stage$1_$2_C_OBJS)) -endif -endef -$(foreach w,$(compiler_stage1_WAYS),$(eval $(call keepCAFsForGHCiDynOnly,1,$w))) -$(foreach w,$(compiler_stage2_WAYS),$(eval $(call keepCAFsForGHCiDynOnly,2,$w))) -$(foreach w,$(compiler_stage3_WAYS),$(eval $(call keepCAFsForGHCiDynOnly,3,$w))) - # after build-package, because that adds --enable-library-for-ghci # to compiler_stage*_CONFIGURE_OPTS: # We don't build the GHCi library for the ghc package. We can load it ===================================== configure.ac ===================================== @@ -780,6 +780,10 @@ FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE1],[CONF_GCC_LINKER_OPTS_STAG FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE2],[CONF_GCC_LINKER_OPTS_STAGE2],[CONF_LD_LINKER_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2]) # Stage 3 won't be supported by cross-compilation +FP_LD_NO_FIXUP_CHAINS([target], [LDFLAGS]) +FP_LD_NO_FIXUP_CHAINS([build], [CONF_GCC_LINKER_OPTS_STAGE0]) +FP_LD_NO_FIXUP_CHAINS([target], [CONF_GCC_LINKER_OPTS_STAGE1]) +FP_LD_NO_FIXUP_CHAINS([target], [CONF_GCC_LINKER_OPTS_STAGE2]) dnl ** See whether cc supports --target= and set dnl CONF_CC_OPTS_STAGE[12] accordingly. FP_CC_SUPPORTS_TARGET ===================================== hadrian/src/Settings/Flavours/Performance.hs ===================================== @@ -13,6 +13,6 @@ performanceFlavour = defaultFlavour performanceArgs :: Args performanceArgs = sourceArgs SourceArgs { hsDefault = pure ["-O", "-H64m"] - , hsLibrary = notStage0 ? arg "-O2" + , hsLibrary = mconcat [notStage0 ? arg "-O2", notStage0 ? arg "-haddock"] , hsCompiler = pure ["-O2"] , hsGhc = mconcat [stage0 ? arg "-O", notStage0 ? arg "-O2"] } ===================================== m4/fp_ld_no_fixup_chains.m4 ===================================== @@ -0,0 +1,24 @@ +# FP_LD_NO_FIXUP_CHAINS +# -------------------- +# See if whether we are using a version of ld64 on darwin platforms which +# requires us to pass -no_fixup_chains +# +# $1 = the platform +# $2 = the name of the linker flags variable when linking with $CC +AC_DEFUN([FP_LD_NO_FIXUP_CHAINS], [ + case $$1 in + *-darwin) + AC_MSG_CHECKING([whether ld64 requires -no_fixup_chains]) + echo 'int main(void) {return 0;}' > conftest.c + if $CC -o conftest.o -Wl,-no_fixup_chains conftest.c > /dev/null 2>&1 + then + $2="-Wl,-no_fixup_chains" + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + fi + rm -f conftest.c conftest.o + ;; + + esac +]) ===================================== testsuite/tests/codeGen/should_run/T22798.hs ===================================== @@ -0,0 +1,375 @@ +-- Derived from SHA-1.5.0.0 +-- This previously uncovered cases left unhandled in the AArch64 NCG (#22798). + +{-# LANGUAGE BangPatterns, CPP, FlexibleInstances #-} +module Main (main) where + +import Data.Binary +import Data.Binary.Get +import Data.Binary.Put +import Data.Bits +import Data.ByteString.Lazy(ByteString) +import Data.ByteString.Lazy.Char8 as BSC (pack) +import qualified Data.ByteString.Lazy as BS +import Data.Char (intToDigit) +import Control.Monad + +newtype Digest t = Digest ByteString + +data SHA512State = SHA512S !Word64 !Word64 !Word64 !Word64 + !Word64 !Word64 !Word64 !Word64 + +initialSHA512State :: SHA512State +initialSHA512State = SHA512S 0x6a09e667f3bcc908 0xbb67ae8584caa73b + 0x3c6ef372fe94f82b 0xa54ff53a5f1d36f1 + 0x510e527fade682d1 0x9b05688c2b3e6c1f + 0x1f83d9abfb41bd6b 0x5be0cd19137e2179 + + +synthesizeSHA512 :: SHA512State -> Put +synthesizeSHA512 (SHA512S a b c d e f g h) = do + putWord64be a + putWord64be b + putWord64be c + putWord64be d + putWord64be e + putWord64be f + putWord64be g + putWord64be h + +getSHA512 :: Get SHA512State +getSHA512 = do + a <- getWord64be + b <- getWord64be + c <- getWord64be + d <- getWord64be + e <- getWord64be + f <- getWord64be + g <- getWord64be + h <- getWord64be + return $ SHA512S a b c d e f g h + +instance Binary SHA512State where + put = synthesizeSHA512 + get = getSHA512 + +padSHA512 :: ByteString -> ByteString +padSHA512 = generic_pad 896 1024 128 + +generic_pad :: Word64 -> Word64 -> Int -> ByteString -> ByteString +generic_pad a b lSize bs = BS.concat [bs, pad_bytes, pad_length] + where + l = fromIntegral $ BS.length bs * 8 + k = calc_k a b l + -- INVARIANT: k is necessarily > 0, and (k + 1) is a multiple of 8. + k_bytes = (k + 1) `div` 8 + pad_bytes = BS.singleton 0x80 `BS.append` BS.replicate nZeroBytes 0 + nZeroBytes = fromIntegral $ k_bytes - 1 + pad_length = toBigEndianBS lSize l + +-- Given a, b, and l, calculate the smallest k such that (l + 1 + k) mod b = a. +calc_k :: Word64 -> Word64 -> Word64 -> Word64 +calc_k a b l = + if r <= -1 + then fromIntegral r + b + else fromIntegral r + where + r = toInteger a - toInteger l `mod` toInteger b - 1 + +toBigEndianBS :: (Integral a, Bits a) => Int -> a -> ByteString +toBigEndianBS s val = BS.pack $ map getBits [s - 8, s - 16 .. 0] + where + getBits x = fromIntegral $ (val `shiftR` x) .&. 0xFF + +{-# SPECIALIZE ch :: Word64 -> Word64 -> Word64 -> Word64 #-} +ch :: Bits a => a -> a -> a -> a +ch x y z = (x .&. y) `xor` (complement x .&. z) + +{-# SPECIALIZE maj :: Word64 -> Word64 -> Word64 -> Word64 #-} +maj :: Bits a => a -> a -> a -> a +maj x y z = (x .&. (y .|. z)) .|. (y .&. z) +-- note: +-- the original functions is (x & y) ^ (x & z) ^ (y & z) +-- if you fire off truth tables, this is equivalent to +-- (x & y) | (x & z) | (y & z) +-- which you can the use distribution on: +-- (x & (y | z)) | (y & z) +-- which saves us one operation. + +bsig512_0 :: Word64 -> Word64 +bsig512_0 x = rotate x (-28) `xor` rotate x (-34) `xor` rotate x (-39) + +bsig512_1 :: Word64 -> Word64 +bsig512_1 x = rotate x (-14) `xor` rotate x (-18) `xor` rotate x (-41) + +lsig512_0 :: Word64 -> Word64 +lsig512_0 x = rotate x (-1) `xor` rotate x (-8) `xor` shiftR x 7 + +lsig512_1 :: Word64 -> Word64 +lsig512_1 x = rotate x (-19) `xor` rotate x (-61) `xor` shiftR x 6 + +data SHA512Sched = SHA512Sched !Word64 !Word64 !Word64 !Word64 !Word64 -- 0- 4 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 5- 9 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 10-14 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 15-19 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 20-24 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 25-29 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 30-34 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 35-39 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 40-44 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 45-49 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 50-54 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 55-59 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 60-64 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 65-69 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 70-74 + !Word64 !Word64 !Word64 !Word64 !Word64 -- 75-79 + +getSHA512Sched :: Get SHA512Sched +getSHA512Sched = do + w00 <- getWord64be + w01 <- getWord64be + w02 <- getWord64be + w03 <- getWord64be + w04 <- getWord64be + w05 <- getWord64be + w06 <- getWord64be + w07 <- getWord64be + w08 <- getWord64be + w09 <- getWord64be + w10 <- getWord64be + w11 <- getWord64be + w12 <- getWord64be + w13 <- getWord64be + w14 <- getWord64be + w15 <- getWord64be + let w16 = lsig512_1 w14 + w09 + lsig512_0 w01 + w00 + w17 = lsig512_1 w15 + w10 + lsig512_0 w02 + w01 + w18 = lsig512_1 w16 + w11 + lsig512_0 w03 + w02 + w19 = lsig512_1 w17 + w12 + lsig512_0 w04 + w03 + w20 = lsig512_1 w18 + w13 + lsig512_0 w05 + w04 + w21 = lsig512_1 w19 + w14 + lsig512_0 w06 + w05 + w22 = lsig512_1 w20 + w15 + lsig512_0 w07 + w06 + w23 = lsig512_1 w21 + w16 + lsig512_0 w08 + w07 + w24 = lsig512_1 w22 + w17 + lsig512_0 w09 + w08 + w25 = lsig512_1 w23 + w18 + lsig512_0 w10 + w09 + w26 = lsig512_1 w24 + w19 + lsig512_0 w11 + w10 + w27 = lsig512_1 w25 + w20 + lsig512_0 w12 + w11 + w28 = lsig512_1 w26 + w21 + lsig512_0 w13 + w12 + w29 = lsig512_1 w27 + w22 + lsig512_0 w14 + w13 + w30 = lsig512_1 w28 + w23 + lsig512_0 w15 + w14 + w31 = lsig512_1 w29 + w24 + lsig512_0 w16 + w15 + w32 = lsig512_1 w30 + w25 + lsig512_0 w17 + w16 + w33 = lsig512_1 w31 + w26 + lsig512_0 w18 + w17 + w34 = lsig512_1 w32 + w27 + lsig512_0 w19 + w18 + w35 = lsig512_1 w33 + w28 + lsig512_0 w20 + w19 + w36 = lsig512_1 w34 + w29 + lsig512_0 w21 + w20 + w37 = lsig512_1 w35 + w30 + lsig512_0 w22 + w21 + w38 = lsig512_1 w36 + w31 + lsig512_0 w23 + w22 + w39 = lsig512_1 w37 + w32 + lsig512_0 w24 + w23 + w40 = lsig512_1 w38 + w33 + lsig512_0 w25 + w24 + w41 = lsig512_1 w39 + w34 + lsig512_0 w26 + w25 + w42 = lsig512_1 w40 + w35 + lsig512_0 w27 + w26 + w43 = lsig512_1 w41 + w36 + lsig512_0 w28 + w27 + w44 = lsig512_1 w42 + w37 + lsig512_0 w29 + w28 + w45 = lsig512_1 w43 + w38 + lsig512_0 w30 + w29 + w46 = lsig512_1 w44 + w39 + lsig512_0 w31 + w30 + w47 = lsig512_1 w45 + w40 + lsig512_0 w32 + w31 + w48 = lsig512_1 w46 + w41 + lsig512_0 w33 + w32 + w49 = lsig512_1 w47 + w42 + lsig512_0 w34 + w33 + w50 = lsig512_1 w48 + w43 + lsig512_0 w35 + w34 + w51 = lsig512_1 w49 + w44 + lsig512_0 w36 + w35 + w52 = lsig512_1 w50 + w45 + lsig512_0 w37 + w36 + w53 = lsig512_1 w51 + w46 + lsig512_0 w38 + w37 + w54 = lsig512_1 w52 + w47 + lsig512_0 w39 + w38 + w55 = lsig512_1 w53 + w48 + lsig512_0 w40 + w39 + w56 = lsig512_1 w54 + w49 + lsig512_0 w41 + w40 + w57 = lsig512_1 w55 + w50 + lsig512_0 w42 + w41 + w58 = lsig512_1 w56 + w51 + lsig512_0 w43 + w42 + w59 = lsig512_1 w57 + w52 + lsig512_0 w44 + w43 + w60 = lsig512_1 w58 + w53 + lsig512_0 w45 + w44 + w61 = lsig512_1 w59 + w54 + lsig512_0 w46 + w45 + w62 = lsig512_1 w60 + w55 + lsig512_0 w47 + w46 + w63 = lsig512_1 w61 + w56 + lsig512_0 w48 + w47 + w64 = lsig512_1 w62 + w57 + lsig512_0 w49 + w48 + w65 = lsig512_1 w63 + w58 + lsig512_0 w50 + w49 + w66 = lsig512_1 w64 + w59 + lsig512_0 w51 + w50 + w67 = lsig512_1 w65 + w60 + lsig512_0 w52 + w51 + w68 = lsig512_1 w66 + w61 + lsig512_0 w53 + w52 + w69 = lsig512_1 w67 + w62 + lsig512_0 w54 + w53 + w70 = lsig512_1 w68 + w63 + lsig512_0 w55 + w54 + w71 = lsig512_1 w69 + w64 + lsig512_0 w56 + w55 + w72 = lsig512_1 w70 + w65 + lsig512_0 w57 + w56 + w73 = lsig512_1 w71 + w66 + lsig512_0 w58 + w57 + w74 = lsig512_1 w72 + w67 + lsig512_0 w59 + w58 + w75 = lsig512_1 w73 + w68 + lsig512_0 w60 + w59 + w76 = lsig512_1 w74 + w69 + lsig512_0 w61 + w60 + w77 = lsig512_1 w75 + w70 + lsig512_0 w62 + w61 + w78 = lsig512_1 w76 + w71 + lsig512_0 w63 + w62 + w79 = lsig512_1 w77 + w72 + lsig512_0 w64 + w63 + return $ SHA512Sched w00 w01 w02 w03 w04 w05 w06 w07 w08 w09 + w10 w11 w12 w13 w14 w15 w16 w17 w18 w19 + w20 w21 w22 w23 w24 w25 w26 w27 w28 w29 + w30 w31 w32 w33 w34 w35 w36 w37 w38 w39 + w40 w41 w42 w43 w44 w45 w46 w47 w48 w49 + w50 w51 w52 w53 w54 w55 w56 w57 w58 w59 + w60 w61 w62 w63 w64 w65 w66 w67 w68 w69 + w70 w71 w72 w73 w74 w75 w76 w77 w78 w79 + +processSHA512Block :: SHA512State -> Get SHA512State +processSHA512Block !s00@(SHA512S a00 b00 c00 d00 e00 f00 g00 h00) = do + (SHA512Sched w00 w01 w02 w03 w04 w05 w06 w07 w08 w09 + w10 w11 w12 w13 w14 w15 w16 w17 w18 w19 + w20 w21 w22 w23 w24 w25 w26 w27 w28 w29 + w30 w31 w32 w33 w34 w35 w36 w37 w38 w39 + w40 w41 w42 w43 w44 w45 w46 w47 w48 w49 + w50 w51 w52 w53 w54 w55 w56 w57 w58 w59 + w60 w61 w62 w63 w64 w65 w66 w67 w68 w69 + w70 w71 w72 w73 w74 w75 w76 w77 w78 w79) <- getSHA512Sched + let s01 = step512 s00 0x428a2f98d728ae22 w00 + s02 = step512 s01 0x7137449123ef65cd w01 + s03 = step512 s02 0xb5c0fbcfec4d3b2f w02 + s04 = step512 s03 0xe9b5dba58189dbbc w03 + s05 = step512 s04 0x3956c25bf348b538 w04 + s06 = step512 s05 0x59f111f1b605d019 w05 + s07 = step512 s06 0x923f82a4af194f9b w06 + s08 = step512 s07 0xab1c5ed5da6d8118 w07 + s09 = step512 s08 0xd807aa98a3030242 w08 + s10 = step512 s09 0x12835b0145706fbe w09 + s11 = step512 s10 0x243185be4ee4b28c w10 + s12 = step512 s11 0x550c7dc3d5ffb4e2 w11 + s13 = step512 s12 0x72be5d74f27b896f w12 + s14 = step512 s13 0x80deb1fe3b1696b1 w13 + s15 = step512 s14 0x9bdc06a725c71235 w14 + s16 = step512 s15 0xc19bf174cf692694 w15 + s17 = step512 s16 0xe49b69c19ef14ad2 w16 + s18 = step512 s17 0xefbe4786384f25e3 w17 + s19 = step512 s18 0x0fc19dc68b8cd5b5 w18 + s20 = step512 s19 0x240ca1cc77ac9c65 w19 + s21 = step512 s20 0x2de92c6f592b0275 w20 + s22 = step512 s21 0x4a7484aa6ea6e483 w21 + s23 = step512 s22 0x5cb0a9dcbd41fbd4 w22 + s24 = step512 s23 0x76f988da831153b5 w23 + s25 = step512 s24 0x983e5152ee66dfab w24 + s26 = step512 s25 0xa831c66d2db43210 w25 + s27 = step512 s26 0xb00327c898fb213f w26 + s28 = step512 s27 0xbf597fc7beef0ee4 w27 + s29 = step512 s28 0xc6e00bf33da88fc2 w28 + s30 = step512 s29 0xd5a79147930aa725 w29 + s31 = step512 s30 0x06ca6351e003826f w30 + s32 = step512 s31 0x142929670a0e6e70 w31 + s33 = step512 s32 0x27b70a8546d22ffc w32 + s34 = step512 s33 0x2e1b21385c26c926 w33 + s35 = step512 s34 0x4d2c6dfc5ac42aed w34 + s36 = step512 s35 0x53380d139d95b3df w35 + s37 = step512 s36 0x650a73548baf63de w36 + s38 = step512 s37 0x766a0abb3c77b2a8 w37 + s39 = step512 s38 0x81c2c92e47edaee6 w38 + s40 = step512 s39 0x92722c851482353b w39 + s41 = step512 s40 0xa2bfe8a14cf10364 w40 + s42 = step512 s41 0xa81a664bbc423001 w41 + s43 = step512 s42 0xc24b8b70d0f89791 w42 + s44 = step512 s43 0xc76c51a30654be30 w43 + s45 = step512 s44 0xd192e819d6ef5218 w44 + s46 = step512 s45 0xd69906245565a910 w45 + s47 = step512 s46 0xf40e35855771202a w46 + s48 = step512 s47 0x106aa07032bbd1b8 w47 + s49 = step512 s48 0x19a4c116b8d2d0c8 w48 + s50 = step512 s49 0x1e376c085141ab53 w49 + s51 = step512 s50 0x2748774cdf8eeb99 w50 + s52 = step512 s51 0x34b0bcb5e19b48a8 w51 + s53 = step512 s52 0x391c0cb3c5c95a63 w52 + s54 = step512 s53 0x4ed8aa4ae3418acb w53 + s55 = step512 s54 0x5b9cca4f7763e373 w54 + s56 = step512 s55 0x682e6ff3d6b2b8a3 w55 + s57 = step512 s56 0x748f82ee5defb2fc w56 + s58 = step512 s57 0x78a5636f43172f60 w57 + s59 = step512 s58 0x84c87814a1f0ab72 w58 + s60 = step512 s59 0x8cc702081a6439ec w59 + s61 = step512 s60 0x90befffa23631e28 w60 + s62 = step512 s61 0xa4506cebde82bde9 w61 + s63 = step512 s62 0xbef9a3f7b2c67915 w62 + s64 = step512 s63 0xc67178f2e372532b w63 + s65 = step512 s64 0xca273eceea26619c w64 + s66 = step512 s65 0xd186b8c721c0c207 w65 + s67 = step512 s66 0xeada7dd6cde0eb1e w66 + s68 = step512 s67 0xf57d4f7fee6ed178 w67 + s69 = step512 s68 0x06f067aa72176fba w68 + s70 = step512 s69 0x0a637dc5a2c898a6 w69 + s71 = step512 s70 0x113f9804bef90dae w70 + s72 = step512 s71 0x1b710b35131c471b w71 + s73 = step512 s72 0x28db77f523047d84 w72 + s74 = step512 s73 0x32caab7b40c72493 w73 + s75 = step512 s74 0x3c9ebe0a15c9bebc w74 + s76 = step512 s75 0x431d67c49c100d4c w75 + s77 = step512 s76 0x4cc5d4becb3e42b6 w76 + s78 = step512 s77 0x597f299cfc657e2a w77 + s79 = step512 s78 0x5fcb6fab3ad6faec w78 + s80 = step512 s79 0x6c44198c4a475817 w79 + SHA512S a80 b80 c80 d80 e80 f80 g80 h80 = s80 + return $ SHA512S (a00 + a80) (b00 + b80) (c00 + c80) (d00 + d80) + (e00 + e80) (f00 + f80) (g00 + g80) (h00 + h80) + +{-# INLINE step512 #-} +step512 :: SHA512State -> Word64 -> Word64 -> SHA512State +step512 !(SHA512S a b c d e f g h) k w = SHA512S a' b' c' d' e' f' g' h' + where + t1 = h + bsig512_1 e + ch e f g + k + w + t2 = bsig512_0 a + maj a b c + h' = g + g' = f + f' = e + e' = d + t1 + d' = c + c' = b + b' = a + a' = t1 + t2 + +runSHA :: a -> (a -> Get a) -> ByteString -> a +runSHA s nextChunk input = runGet (getAll s) input + where + getAll s_in = do + done <- isEmpty + if done + then return s_in + else nextChunk s_in >>= getAll + +sha512 :: ByteString -> Digest SHA512State +sha512 bs_in = Digest bs_out + where + bs_pad = padSHA512 bs_in + fstate = runSHA initialSHA512State processSHA512Block bs_pad + bs_out = runPut $ synthesizeSHA512 fstate + +sha512_spec_tests :: [(String, String)] +sha512_spec_tests = + [("abc", + "ddaf35a193617abacc417349ae20413112e6fa4e89a97ea20a9eeee64b55d39a" ++ + "2192992a274fc1a836ba3c23a3feebbd454d4423643ce80e2a9ac94fa54ca49f"), + ("abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmn" ++ + "hijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu", + "8e959b75dae313da8cf4f72814fc143f8f7779c6eb9f7fa17299aeadb6889018" ++ + "501d289e4900f7e4331b99dec4b5433ac7d329eeb6dd26545e96e55b874be909"), + (replicate 1000000 'a', + "e718483d0ce769644e2e42c7bc15b4638e1f98b13b2044285632a803afa973eb" ++ + "de0ff244877ea60a4cb0432ce577c31beb009c5c2c49aa2e4eadb217ad8cc09b")] + +showDigest :: Digest t -> String +showDigest (Digest bs) = showDigestBS bs + +-- |Prints out a bytestring in hexadecimal. Just for convenience. +showDigestBS :: ByteString -> String +showDigestBS bs = foldr paddedShowHex [] (BS.unpack bs) + where + paddedShowHex x xs = intToDigit (fromIntegral (x `shiftR` 4)) + : intToDigit (fromIntegral (x .&. 0xf)) + : xs + +main :: IO () +main = do + sequence_ + [ unless (digest == expected) + $ fail $ "failed: " ++ expected ++ " /= " ++ digest + | (str, expected) <- sha512_spec_tests + , let digest = showDigest (sha512 $ BSC.pack str) + ] ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -219,3 +219,4 @@ test('CallConv', [when(unregisterised(), skip), when(arch('x86_64'), extra_hc_opts('CallConv_x86_64.s')), when(arch('aarch64'), extra_hc_opts('CallConv_aarch64.s'))], compile_and_run, ['']) +test('T22798', normal, compile_and_run, ['-fregs-graph']) ===================================== testsuite/tests/ghci/T16392/T16392.script ===================================== @@ -1,5 +1,7 @@ :set -fobject-code +import System.Mem :load A.hs c_two caf +performMajorGC :load A.hs c_two caf ===================================== testsuite/tests/ghci/linking/dyn/Makefile ===================================== @@ -74,7 +74,7 @@ compile_libAB_dyn: '$(TEST_HC)' $(MY_TEST_HC_OPTS) -odir "bin_dyn" -shared B.c -o "bin_dyn/$(call DLL,B)" -lA -L"./bin_dyn" rm -f bin_dyn/*.a '$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -v0 -o "bin_dyn/$(call EXE,T10955dyn)" -L./bin_dyn -lB -lA T10955dyn.hs -v0 - LD_LIBRARY_PATH=./bin_dyn ./bin_dyn/$(call EXE,T10955dyn) + DYLD_LIBRARY_PATH=./bin_dyn LD_LIBRARY_PATH=./bin_dyn ./bin_dyn/$(call EXE,T10955dyn) .PHONY: compile_libAS_impl_gcc compile_libAS_impl_gcc: ===================================== testsuite/tests/rts/T18623/all.T ===================================== @@ -5,7 +5,10 @@ test('T18623', # This keeps failing on aarch64-linux for reasons that are not # fully clear. Maybe it needs a higher limit due to LLMV? when(arch('aarch64'), skip), + # Recent versions of osx report an error when running `ulimit -v` + when(opsys('darwin'), skip), + when(arch('powerpc64le'), skip), cmd_prefix('ulimit -v ' + str(1024 ** 2) + ' && '), ignore_stdout], run_command, - ['{compiler} --version']) \ No newline at end of file + ['{compiler} --version']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/422315577c379bddfc5bb25c42945e6c87f107ad...03e3451ecd876be19d13896a50ca935a66a353bb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/422315577c379bddfc5bb25c42945e6c87f107ad...03e3451ecd876be19d13896a50ca935a66a353bb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 21:21:42 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Thu, 02 Feb 2023 16:21:42 -0500 Subject: [Git][ghc/ghc][wip/9.2.6-backports] 21 commits: Only gc sparks locally when we can ensure marking is done. Message-ID: <63dc296635b6f_1108fe5260c279060@gitlab.mail> Zubin pushed to branch wip/9.2.6-backports at Glasgow Haskell Compiler / GHC Commits: b6807acf by Andreas Klebinger at 2023-02-03T02:50:41+05:30 Only gc sparks locally when we can ensure marking is done. When performing GC without work stealing there was no guarantee that spark pruning was happening after marking of the sparks. This could cause us to GC live sparks under certain circumstances. Fixes #22528. (cherry picked from commit a1491c8791c57a64d94bc08d639d585815c8d4e2) - - - - - 7989e66d by Ian-Woo Kim at 2023-02-03T02:50:41+05:30 Truncate eventlog event for large payload (#20221) RTS eventlog events for postCapsetVecEvent are truncated if payload is larger than EVENT_PAYLOAD_SIZE_MAX Previously, postCapsetVecEvent records eventlog event with payload of variable size larger than EVENT_PAYLOAD_SIZE_MAX (2^16) without any validation, resulting in corrupted data. For example, this happens when a Haskell binary is invoked with very long command line arguments exceeding 2^16 bytes (see #20221). Now we check the size of accumulated payload messages incrementally, and truncate the message just before the payload size exceeds EVENT_PAYLOAD_SIZE_MAX. RTS will warn the user with a message showing how many arguments are truncated. (cherry picked from commit 2057c77d08cb8422857d182a3691f98dccd0c7d6) - - - - - 22df68b9 by Simon Peyton Jones at 2023-02-03T02:50:41+05:30 Make FloatIn robust to shadowing This MR fixes #22622. See the new Note [Shadowing and name capture] I did a bit of refactoring in sepBindsByDropPoint too. The bug doesn't manifest in HEAD, but it did show up in 9.4, so we should backport this patch to 9.4 (cherry picked from commit 6206cb9287f3f6e70c669660a646a65274870d2b) - - - - - 3def76f7 by Ben Gamari at 2023-02-03T02:50:41+05:30 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. (cherry picked from commit f891a442046d8a5ebf4d4777847880ce06752b18) - - - - - 34b8ca6c by Ben Gamari at 2023-02-03T02:50:41+05:30 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. (cherry picked from commit b13c6ea5d4b64841164f8cc58d6c6f3de390f2ed) - - - - - 149a30c6 by Oleg Grenrus at 2023-02-03T02:50:41+05:30 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general (cherry picked from commit 1b812b6973a25cb1962e2fc543d2c4ed3cf31f3c) - - - - - 3af2cf2c by Zubin Duggal at 2023-02-03T02:50:41+05:30 Document #22255 and #22468 in bugs.rst - - - - - d010ee2c by Simon Peyton Jones at 2023-02-03T02:50:42+05:30 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 (cherry picked from commit 3d55d8ab51ece43c51055c43c9e7aba77cce46c0) - - - - - df32ff94 by Simon Peyton Jones at 2023-02-03T02:50:42+05:30 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. (cherry picked from commit e193e53790dd5886feea3cf4c9c17625d188291b) - - - - - 43adca21 by Sebastian Graf at 2023-02-03T02:50:42+05:30 DmdAnal: Don't panic in addCaseBndrDmd (#22039) Rather conservatively return Top. See Note [Untyped demand on case-alternative binders]. I also factored `addCaseBndrDmd` into two separate functions `scrutSubDmd` and `fieldBndrDmds`. Fixes #22039. (cherry picked from commit d2be80fd9b222963e8dd09a30f78c106e00da7f9) - - - - - 84e8a879 by Matthew Pickering at 2023-02-03T02:50:42+05:30 ApplicativeDo: Set pattern location before running exhaustiveness checker This improves the error messages of the exhaustiveness checker when checking statements which have been moved around with ApplicativeDo. Before: Test.hs:2:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 2 | let x = () | ^^^^^^^^^^ After: Test.hs:4:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 4 | ~(Just res1) <- seq x (pure $ Nothing @()) | Fixes #22483 (cherry picked from commit 74c767df770766d8d52e87b9ff7da10f94620a91) (cherry picked from commit 51c6051bcc405bc1dbddd450ade949acd70db6b8) - - - - - 7d2c7003 by Andreas Klebinger at 2023-02-03T02:50:42+05:30 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- (cherry picked from commit 08ba87200ff068aa37cac082e61ee7e2d534daf5) - - - - - f2bfb363 by Matthew Pickering at 2023-02-03T02:50:42+05:30 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s (cherry picked from commit a960ca817d6ad0109ea6edda50da3902cc538e86) - - - - - aae855d2 by Matthew Pickering at 2023-02-03T02:50:42+05:30 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. (cherry picked from commit 734847108420cf826a807c30ad54651659cf3a08) - - - - - 9d28b177 by Matthew Pickering at 2023-02-03T02:50:42+05:30 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes (cherry picked from commit 8c0ea25fb4a27d4729aabf73f4c00b912bb0c58d) - - - - - 76dfad78 by Cheng Shao at 2023-02-03T02:50:42+05:30 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. (cherry picked from commit c45a5fffef2c76efbf5d3a009c3f6d0244a63f0d) - - - - - 99dbe895 by Ben Gamari at 2023-02-03T02:50:42+05:30 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. (cherry picked from commit be417a47c7695998dea0adc05489a7b8838a78b6) - - - - - 9e43e3b5 by Ben Gamari at 2023-02-03T02:50:42+05:30 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. (cherry picked from commit 30989d137b8f3a8fddbfd116e04b48f23c24f86c) - - - - - 14de1fa9 by Ben Gamari at 2023-02-03T02:50:42+05:30 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. (cherry picked from commit 7566fd9de38c67360c090f828923d41587af519c) - - - - - fb165779 by Ben Gamari at 2023-02-03T02:50:42+05:30 testsuite: Add regression test for #22798 (cherry picked from commit 2cb500a5ee1a31dfe1a2cdd71f175442026eb082) - - - - - 1f5fb83f by Zubin Duggal at 2023-02-03T02:50:42+05:30 hadrian: enable -haddock in perf flavour (#22734) - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/HsToCore/Expr.hs - compiler/cbits/keepCAFsForGHCi.c - compiler/ghc.mk - configure.ac - docs/users_guide/bugs.rst - hadrian/src/Settings/Flavours/Performance.hs - libraries/ghc-bignum/gmp/gmp-tarballs - + m4/fp_ld_no_fixup_chains.m4 - rts/Sparks.c - rts/eventlog/EventLog.c - rts/sm/GC.c - + testsuite/tests/ado/T22483.hs - + testsuite/tests/ado/T22483.stderr - testsuite/tests/ado/all.T - + testsuite/tests/codeGen/should_run/T22798.hs - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/ghci/T16392/T16392.script - testsuite/tests/ghci/linking/dyn/Makefile - testsuite/tests/rts/T18623/all.T - + testsuite/tests/safeHaskell/warnings/Makefile - + testsuite/tests/safeHaskell/warnings/T22728.hs - + testsuite/tests/safeHaskell/warnings/T22728.stderr - + testsuite/tests/safeHaskell/warnings/T22728_B.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/03e3451ecd876be19d13896a50ca935a66a353bb...1f5fb83f3924b04fb0eb3bc335dc0b54e3249c28 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/03e3451ecd876be19d13896a50ca935a66a353bb...1f5fb83f3924b04fb0eb3bc335dc0b54e3249c28 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 21:27:48 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 02 Feb 2023 16:27:48 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/ci-verbosity Message-ID: <63dc2ad4df1a8_1108fec035f028498d@gitlab.mail> Ben Gamari pushed new branch wip/ci-verbosity at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ci-verbosity You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 21:36:06 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 02 Feb 2023 16:36:06 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T22883 Message-ID: <63dc2cc6c265e_1108fe722f55429801f@gitlab.mail> Ben Gamari pushed new branch wip/T22883 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22883 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 21:37:58 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 02 Feb 2023 16:37:58 -0500 Subject: [Git][ghc/ghc][wip/T22686] hih Message-ID: <63dc2d36c4ff3_1108fe5262030177@gitlab.mail> Ben Gamari pushed to branch wip/T22686 at Glasgow Haskell Compiler / GHC Commits: bad48f74 by Ben Gamari at 2023-02-02T16:37:47-05:00 hih - - - - - 1 changed file: - .gitlab/jobs.yaml Changes: ===================================== .gitlab/jobs.yaml ===================================== @@ -11,6 +11,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -73,6 +74,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -131,6 +133,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -189,6 +192,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -252,6 +256,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -311,6 +316,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate+llvm.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -370,6 +376,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -429,6 +436,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -494,6 +502,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -555,6 +564,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-cross_wasm32-wasi-release+fully_static.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -616,6 +626,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -677,6 +688,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -740,6 +752,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -801,6 +814,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -864,6 +878,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-centos7-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -924,6 +939,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -983,6 +999,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1042,6 +1059,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1102,6 +1120,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1161,6 +1180,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1220,6 +1240,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1279,6 +1300,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1338,6 +1360,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1399,6 +1422,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1460,6 +1484,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_js-unknown-ghcjs-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1521,6 +1546,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1580,6 +1606,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb9-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1639,6 +1666,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1700,6 +1728,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1762,6 +1791,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-validate+debug_info.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1823,6 +1853,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-rocky8-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1883,6 +1914,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu18_04-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1942,6 +1974,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu20_04-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2000,6 +2033,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-int_native-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2059,6 +2093,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2119,6 +2154,7 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-darwin-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2183,6 +2219,7 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-linux-deb10-release+no_split_sections.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2243,6 +2280,7 @@ "expire_in": "1 year", "paths": [ "ghc-i386-linux-deb9-release+no_split_sections.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2303,6 +2341,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-darwin-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2369,6 +2408,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2433,6 +2473,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2497,6 +2538,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-centos7-release+no_split_sections.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2558,6 +2600,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2618,6 +2661,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release+debug_info.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2678,6 +2722,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2738,6 +2783,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb9-release+no_split_sections.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2798,6 +2844,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2860,6 +2907,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release+debug_info.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2922,6 +2970,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2985,6 +3034,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-rocky8-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3046,6 +3096,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu18_04-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3106,6 +3157,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu20_04-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3165,6 +3217,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-int_native-release+no_split_sections.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3225,6 +3278,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-release+no_split_sections.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3286,6 +3340,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3350,6 +3405,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3410,6 +3466,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-cross_wasm32-wasi-release+fully_static.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3470,6 +3527,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3532,6 +3590,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3590,6 +3649,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3649,6 +3709,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3708,6 +3769,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3766,6 +3828,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3824,6 +3887,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3882,6 +3946,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3943,6 +4008,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -4003,6 +4069,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_js-unknown-ghcjs-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -4063,6 +4130,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -4122,6 +4190,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bad48f74fae492f69cbc2a5826b0857dc191487e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bad48f74fae492f69cbc2a5826b0857dc191487e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 2 21:42:14 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 02 Feb 2023 16:42:14 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Disable unfolding sharing for interface files with core definitions Message-ID: <63dc2e3690c9e_1108fe525f83113d0@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - f051ce0c by lrzlin at 2023-02-02T16:41:56-05:00 Enable tables next to code for LoongArch64 - - - - - 4c3f40df by Wander Hillen at 2023-02-02T16:42:01-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - a3c933a3 by Ben Gamari at 2023-02-02T16:42:02-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 18 changed files: - compiler/GHC/CmmToLlvm/Mangler.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/IfaceToCore.hs - compiler/ghc.cabal.in - libraries/base/GHC/IO/Handle/Types.hs - libraries/ghci/GHCi/InfoTable.hsc - m4/ghc_tables_next_to_code.m4 - rts/posix/Ticker.c - rts/posix/ticker/Pthread.c - + rts/posix/ticker/TimerFd.c - testsuite/tests/driver/fat-iface/Makefile - + testsuite/tests/driver/fat-iface/T22807.stdout - + testsuite/tests/driver/fat-iface/T22807A.hs - + testsuite/tests/driver/fat-iface/T22807B.hs - + testsuite/tests/driver/fat-iface/T22807_ghci.hs - + testsuite/tests/driver/fat-iface/T22807_ghci.script - + testsuite/tests/driver/fat-iface/T22807_ghci.stdout - testsuite/tests/driver/fat-iface/all.T Changes: ===================================== compiler/GHC/CmmToLlvm/Mangler.hs ===================================== @@ -38,7 +38,7 @@ llvmFixupAsm platform f1 f2 = {-# SCC "llvm_mangler" #-} -- | These are the rewrites that the mangler will perform rewrites :: [Rewrite] -rewrites = [rewriteSymType, rewriteAVX, rewriteCall] +rewrites = [rewriteSymType, rewriteAVX, rewriteCall, rewriteJump] type Rewrite = Platform -> B.ByteString -> Maybe B.ByteString @@ -123,6 +123,29 @@ rewriteCall platform l removePlt = replaceOnce (B.pack "@plt") (B.pack "") appendInsn i = (`B.append` B.pack ("\n\t" ++ i)) +-- | This rewrites bl and b jump inst to avoid creating PLT entries for +-- functions on loongarch64, because there is no separate call instruction +-- for function calls in loongarch64. Also, this replacement will load +-- the function address from the GOT, which is resolved to point to the +-- real address of the function. +rewriteJump :: Rewrite +rewriteJump platform l + | not isLoongArch64 = Nothing + | isBL l = Just $ replaceJump "bl" "$ra" "$ra" l + | isB l = Just $ replaceJump "b" "$zero" "$t0" l + | otherwise = Nothing + where + isLoongArch64 = platformArch platform == ArchLoongArch64 + isBL = B.isPrefixOf (B.pack "bl\t") + isB = B.isPrefixOf (B.pack "b\t") + + replaceJump jump rd rj l = + appendInsn ("jirl" ++ "\t" ++ rd ++ ", " ++ rj ++ ", 0") $ removeBracket $ + replaceOnce (B.pack (jump ++ "\t%plt(")) (B.pack ("la\t" ++ rj ++ ", ")) l + where + removeBracket = replaceOnce (B.pack ")") (B.pack "") + appendInsn i = (`B.append` B.pack ("\n\t" ++ i)) + -- | @replaceOnce match replace bs@ replaces the first occurrence of the -- substring @match@ in @bs@ with @replace at . replaceOnce :: B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -604,8 +604,12 @@ toIfaceTopBind b = IfLclTopBndr {} -> IfRhs (toIfaceExpr rhs) in (top_bndr, rhs') - already_has_unfolding b = - -- The identifier has an unfolding, which we are going to serialise anyway + -- The sharing behaviour is currently disabled due to #22807, and relies on + -- finished #220056 to be re-enabled. + disabledDueTo22807 = True + + already_has_unfolding b = not disabledDueTo22807 + && -- The identifier has an unfolding, which we are going to serialise anyway hasCoreUnfolding (realIdUnfolding b) -- But not a stable unfolding, we want the optimised unfoldings. && not (isStableUnfolding (realIdUnfolding b)) @@ -771,7 +775,10 @@ is that these NOINLINE'd functions now can't be profitably inlined outside of the hs-boot loop. Note [Interface File with Core: Sharing RHSs] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +IMPORTANT: This optimisation is currently disabled due to #22027, it can be + re-enabled once #220056 is implemented. In order to avoid duplicating definitions for bindings which already have unfoldings we do some minor headstands to avoid serialising the RHS of a definition if it has ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -933,7 +933,13 @@ tc_iface_bindings (IfaceRec bs) = do -- | See Note [Interface File with Core: Sharing RHSs] tc_iface_binding :: Id -> IfaceMaybeRhs -> IfL CoreExpr -tc_iface_binding i IfUseUnfoldingRhs = return (unfoldingTemplate $ realIdUnfolding i) +tc_iface_binding i IfUseUnfoldingRhs = + case maybeUnfoldingTemplate $ realIdUnfolding i of + Just e -> return e + Nothing -> pprPanic "tc_iface_binding" (vcat [text "Binding" <+> quotes (ppr i) <+> text "had an unfolding when the interface file was created" + , text "which has now gone missing, something has badly gone wrong." + , text "Unfolding:" <+> ppr (realIdUnfolding i)]) + tc_iface_binding _ (IfRhs rhs) = tcIfaceExpr rhs mk_top_id :: IfaceTopBndrInfo -> IfL Id ===================================== compiler/ghc.cabal.in ===================================== @@ -557,6 +557,7 @@ Library GHC.Platform.ARM GHC.Platform.AArch64 GHC.Platform.Constants + GHC.Platform.LoongArch64 GHC.Platform.NoRegs GHC.Platform.PPC GHC.Platform.Profile @@ -564,7 +565,6 @@ Library GHC.Platform.Reg.Class GHC.Platform.Regs GHC.Platform.RISCV64 - GHC.Platform.LoongArch64 GHC.Platform.S390X GHC.Platform.Wasm32 GHC.Platform.Ways ===================================== libraries/base/GHC/IO/Handle/Types.hs ===================================== @@ -124,11 +124,11 @@ data Handle__ Handle__ { haDevice :: !dev, haType :: HandleType, -- type (read/write/append etc.) - haByteBuffer :: !(IORef (Buffer Word8)), -- See [note Buffering Implementation] + haByteBuffer :: !(IORef (Buffer Word8)), -- See Note [Buffering Implementation] haBufferMode :: BufferMode, haLastDecode :: !(IORef (dec_state, Buffer Word8)), -- ^ The byte buffer just before we did our last batch of decoding. - haCharBuffer :: !(IORef (Buffer CharBufElem)), -- See [note Buffering Implementation] + haCharBuffer :: !(IORef (Buffer CharBufElem)), -- See Note [Buffering Implementation] haBuffers :: !(IORef (BufferList CharBufElem)), -- spare buffers haEncoder :: Maybe (TextEncoder enc_state), haDecoder :: Maybe (TextDecoder dec_state), @@ -261,13 +261,13 @@ data BufferMode ) {- -[note Buffering Implementation] - +Note [Buffering Implementation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Each Handle has two buffers: a byte buffer (haByteBuffer) and a Char buffer (haCharBuffer). -[note Buffered Reading] - +Note [Buffered Reading] +~~~~~~~~~~~~~~~~~~~~~~~ For read Handles, bytes are read into the byte buffer, and immediately decoded into the Char buffer (see GHC.IO.Handle.Internals.readTextDevice). The only way there might be @@ -279,8 +279,8 @@ reading data into a Handle. When reading, we can always just read all the data there is available without blocking, decode it into the Char buffer, and then provide it immediately to the caller. -[note Buffered Writing] - +Note [Buffered Writing] +~~~~~~~~~~~~~~~~~~~~~~~ Characters are written into the Char buffer by e.g. hPutStr. At the end of the operation, or when the char buffer is full, the buffer is decoded to the byte buffer (see writeCharBuffer). This is so that we @@ -288,8 +288,8 @@ can detect encoding errors at the right point. Hence, the Char buffer is always empty between Handle operations. -[note Buffer Sizing] - +Note [Buffer Sizing] +~~~~~~~~~~~~~~~~~~~~ The char buffer is always a default size (dEFAULT_CHAR_BUFFER_SIZE). The byte buffer size is chosen by the underlying device (via its IODevice.newBuffer). Hence the size of these buffers is not under @@ -322,8 +322,8 @@ writeCharBuffer, which checks whether the buffer should be flushed according to the current buffering mode. Additionally, we look for newlines and flush if the mode is LineBuffering. -[note Buffer Flushing] - +Note [Buffer Flushing] +~~~~~~~~~~~~~~~~~~~~~~ ** Flushing the Char buffer We must be able to flush the Char buffer, in order to implement ===================================== libraries/ghci/GHCi/InfoTable.hsc ===================================== @@ -228,6 +228,15 @@ mkJumpToAddr a = case hostPlatformArch of , fromIntegral w64 , fromIntegral (w64 `shiftR` 32) ] + ArchLoongArch64 -> pure $ + let w64 = fromIntegral (funPtrToInt a) :: Word64 + in Right [ 0x1c00000c -- pcaddu12i $t0,0 + , 0x28c0418c -- ld.d $t0,$t0,16 + , 0x4c000180 -- jr $t0 + , 0x03400000 -- nop + , fromIntegral w64 + , fromIntegral (w64 `shiftR` 32) ] + arch -> -- The arch isn't supported. You either need to add your architecture as a -- distinct case, or use non-TABLES_NEXT_TO_CODE mode. ===================================== m4/ghc_tables_next_to_code.m4 ===================================== @@ -17,7 +17,7 @@ AC_DEFUN([GHC_TABLES_NEXT_TO_CODE], case "$Unregisterised" in NO) case "$TargetArch" in - ia64|powerpc64|powerpc64le|s390x|wasm32|loongarch64) + ia64|powerpc64|powerpc64le|s390x|wasm32) TablesNextToCodeDefault=NO AC_MSG_RESULT([no]) ;; ===================================== rts/posix/Ticker.c ===================================== @@ -65,13 +65,17 @@ * On Linux we can use timerfd_* (introduced in Linux * 2.6.25) and a thread instead of alarm signals. It avoids the risk of * interrupting syscalls (see #10840) and the risk of being accidentally - * modified in user code using signals. + * modified in user code using signals. NetBSD has also added timerfd + * support since version 10. + * + * For older version of linux/netbsd without timerfd we fall back to the + * pthread based implementation. */ -#if defined(linux_HOST_OS) && HAVE_SYS_TIMERFD_H -#define USE_PTHREAD_FOR_ITIMER +#if HAVE_SYS_TIMERFD_H +#define USE_TIMERFD_FOR_ITIMER #endif -#if defined(freebsd_HOST_OS) +#if defined(linux_HOST_OS) #define USE_PTHREAD_FOR_ITIMER #endif @@ -79,6 +83,10 @@ #define USE_PTHREAD_FOR_ITIMER #endif +#if defined(freebsd_HOST_OS) +#define USE_PTHREAD_FOR_ITIMER +#endif + #if defined(solaris2_HOST_OS) /* USE_TIMER_CREATE is usually disabled for Solaris. In fact it is supported well on this OS, but requires additional privilege. When @@ -98,7 +106,9 @@ ghc-stage2: timer_create: Not owner #endif /* solaris2_HOST_OS */ // Select the variant to use -#if defined(USE_PTHREAD_FOR_ITIMER) +#if defined(USE_TIMERFD_FOR_ITIMER) +#include "ticker/TimerFd.c" +#elif defined(USE_PTHREAD_FOR_ITIMER) #include "ticker/Pthread.c" #elif defined(USE_TIMER_CREATE) #include "ticker/TimerCreate.c" ===================================== rts/posix/ticker/Pthread.c ===================================== @@ -63,13 +63,6 @@ #include #include -#if defined(HAVE_SYS_TIMERFD_H) -#include -#define USE_TIMERFD_FOR_ITIMER 1 -#else -#define USE_TIMERFD_FOR_ITIMER 0 -#endif - /* * TFD_CLOEXEC has been added in Linux 2.6.26. * If it is not available, we use fcntl(F_SETFD). @@ -93,61 +86,16 @@ static Condition start_cond; static Mutex mutex; 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) { - if (poll(pollfds, 2, -1) == -1) { - sysErrorBelch("Ticker: poll failed: %s", strerror(errno)); - } - - // 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) { - sysErrorBelch("Ticker: sleep failed: %s", strerror(errno)); - } + if (rtsSleep(itimer_interval) != 0) { + sysErrorBelch("Ticker: sleep failed: %s", strerror(errno)); } // first try a cheap test @@ -164,10 +112,6 @@ static void *itimer_thread_func(void *_handle_tick) } } - if (USE_TIMERFD_FOR_ITIMER) { - close(timerfd); - } - return NULL; } @@ -186,39 +130,6 @@ initTicker (Time interval, TickProc handle_tick) initCondition(&start_cond); initMutex(&mutex); - /* Open the file descriptor for the timer synchronously. - * - * We used to do it in itimer_thread_func (i.e. in the timer thread) but it - * meant that some user code could run before it and get confused by the - * allocation of the timerfd. - * - * See hClose002 which unsafely closes a file descriptor twice expecting an - * exception the second time: it sometimes failed when the second call to - * "close" closed our own timerfd which inadvertently reused the same file - * descriptor closed by the first call! (see #20618) - */ -#if USE_TIMERFD_FOR_ITIMER - struct itimerspec it; - it.it_value.tv_sec = TimeToSeconds(itimer_interval); - it.it_value.tv_nsec = TimeToNS(itimer_interval) % 1000000000; - it.it_interval = it.it_value; - - timerfd = timerfd_create(CLOCK_MONOTONIC, TFD_CLOEXEC); - if (timerfd == -1) { - barf("timerfd_create: %s", strerror(errno)); - } - if (!TFD_CLOEXEC) { - fcntl(timerfd, F_SETFD, FD_CLOEXEC); - } - if (timerfd_settime(timerfd, 0, &it, NULL)) { - barf("timerfd_settime: %s", strerror(errno)); - } - - if (pipe(pipefds) < 0) { - barf("pipe: %s", strerror(errno)); - } -#endif - /* * Create the thread with all blockable signals blocked, leaving signal * handling to the main and/or other threads. This is especially useful in @@ -269,21 +180,9 @@ 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 { ===================================== rts/posix/ticker/TimerFd.c ===================================== @@ -0,0 +1,280 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1995-2023 + * + * Interval timer for profiling and pre-emptive scheduling. + * + * ---------------------------------------------------------------------------*/ + +/* + * We use a realtime timer by default. I found this much more + * reliable than a CPU timer: + * + * Experiments with different frequencies: using + * CLOCK_REALTIME/CLOCK_MONOTONIC on Linux 2.6.32, + * 1000us has <1% impact on runtime + * 100us has ~2% impact on runtime + * 10us has ~40% impact on runtime + * + * using CLOCK_PROCESS_CPUTIME_ID on Linux 2.6.32, + * I cannot get it to tick faster than 10ms (10000us) + * which isn't great for profiling. + * + * In the threaded RTS, we can't tick in CPU time because the thread + * which has the virtual timer might be idle, so the tick would never + * fire. Therefore we used to tick in realtime in the threaded RTS and + * in CPU time otherwise, but now we always tick in realtime, for + * several reasons: + * + * - resolution (see above) + * - consistency (-threaded is the same as normal) + * - more consistency: Windows only has a realtime timer + * + * Note we want to use CLOCK_MONOTONIC rather than CLOCK_REALTIME, + * because the latter may jump around (NTP adjustments, leap seconds + * etc.). + */ + +#include "rts/PosixSource.h" +#include "Rts.h" + +#include "Ticker.h" +#include "RtsUtils.h" +#include "Proftimer.h" +#include "Schedule.h" +#include "posix/Clock.h" +#include + +#include +#if HAVE_SYS_TIME_H +# include +#endif + +#if defined(HAVE_SIGNAL_H) +# include +#endif + +#include + +#include +#if defined(HAVE_PTHREAD_NP_H) +#include +#endif +#include +#include + +#include + + +/* + * TFD_CLOEXEC has been added in Linux 2.6.26. + * If it is not available, we use fcntl(F_SETFD). + */ +#if !defined(TFD_CLOEXEC) +#define TFD_CLOEXEC 0 +#endif + +static Time itimer_interval = DEFAULT_TICK_INTERVAL; + +// Should we be firing ticks? +// Writers to this must hold the mutex below. +static bool stopped = false; + +// should the ticker thread exit? +// This can be set without holding the mutex. +static bool exited = true; + +// Signaled when we want to (re)start the timer +static Condition start_cond; +static Mutex mutex; +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]; + + pollfds[0].fd = pipefds[0]; + pollfds[0].events = POLLIN; + pollfds[1].fd = timerfd; + pollfds[1].events = POLLIN; + + // 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 (poll(pollfds, 2, -1) == -1) { + sysErrorBelch("Ticker: poll failed: %s", strerror(errno)); + } + + // 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); + } + } + + // first try a cheap test + TSAN_ANNOTATE_BENIGN_RACE(&stopped, "itimer_thread_func"); + if (RELAXED_LOAD(&stopped)) { + OS_ACQUIRE_LOCK(&mutex); + // should we really stop? + if (stopped) { + waitCondition(&start_cond, &mutex); + } + OS_RELEASE_LOCK(&mutex); + } else { + handle_tick(0); + } + } + + close(timerfd); + return NULL; +} + +void +initTicker (Time interval, TickProc handle_tick) +{ + itimer_interval = interval; + stopped = true; + exited = false; +#if defined(HAVE_SIGNAL_H) + sigset_t mask, omask; + int sigret; +#endif + int ret; + + initCondition(&start_cond); + initMutex(&mutex); + + /* Open the file descriptor for the timer synchronously. + * + * We used to do it in itimer_thread_func (i.e. in the timer thread) but it + * meant that some user code could run before it and get confused by the + * allocation of the timerfd. + * + * See hClose002 which unsafely closes a file descriptor twice expecting an + * exception the second time: it sometimes failed when the second call to + * "close" closed our own timerfd which inadvertently reused the same file + * descriptor closed by the first call! (see #20618) + */ + struct itimerspec it; + it.it_value.tv_sec = TimeToSeconds(itimer_interval); + it.it_value.tv_nsec = TimeToNS(itimer_interval) % 1000000000; + it.it_interval = it.it_value; + + timerfd = timerfd_create(CLOCK_MONOTONIC, TFD_CLOEXEC); + if (timerfd == -1) { + barf("timerfd_create: %s", strerror(errno)); + } + if (!TFD_CLOEXEC) { + fcntl(timerfd, F_SETFD, FD_CLOEXEC); + } + if (timerfd_settime(timerfd, 0, &it, NULL)) { + barf("timerfd_settime: %s", strerror(errno)); + } + + if (pipe(pipefds) < 0) { + barf("pipe: %s", strerror(errno)); + } + + /* + * Create the thread with all blockable signals blocked, leaving signal + * handling to the main and/or other threads. This is especially useful in + * the non-threaded runtime, where applications might expect sigprocmask(2) + * to effectively block signals. + */ +#if defined(HAVE_SIGNAL_H) + sigfillset(&mask); + sigret = pthread_sigmask(SIG_SETMASK, &mask, &omask); +#endif + ret = createAttachedOSThread(&thread, "ghc_ticker", itimer_thread_func, (void*)handle_tick); +#if defined(HAVE_SIGNAL_H) + if (sigret == 0) + pthread_sigmask(SIG_SETMASK, &omask, NULL); +#endif + + if (ret != 0) { + barf("Ticker: Failed to spawn thread: %s", strerror(errno)); + } +} + +void +startTicker(void) +{ + OS_ACQUIRE_LOCK(&mutex); + RELAXED_STORE(&stopped, false); + signalCondition(&start_cond); + OS_RELEASE_LOCK(&mutex); +} + +/* There may be at most one additional tick fired after a call to this */ +void +stopTicker(void) +{ + OS_ACQUIRE_LOCK(&mutex); + RELAXED_STORE(&stopped, true); + OS_RELEASE_LOCK(&mutex); +} + +/* There may be at most one additional tick fired after a call to this */ +void +exitTicker (bool wait) +{ + ASSERT(!SEQ_CST_LOAD(&exited)); + SEQ_CST_STORE(&exited, true); + // ensure that ticker wakes up if stopped + startTicker(); + + // wait for ticker to terminate if necessary + if (wait) { + // 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)); + } + + if (pthread_join(thread, NULL)) { + sysErrorBelch("Ticker: Failed to join: %s", strerror(errno)); + } + + // 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]); + + closeMutex(&mutex); + closeCondition(&start_cond); + } else { + pthread_detach(thread); + } +} + +int +rtsTimerSignal(void) +{ + return SIGALRM; +} ===================================== testsuite/tests/driver/fat-iface/Makefile ===================================== @@ -49,4 +49,11 @@ fat010: clean echo >> "THB.hs" "$(TEST_HC)" $(TEST_HC_OPTS) THC.hs -fhide-source-paths -fwrite-if-simplified-core -fprefer-byte-code +T22807: clean + "$(TEST_HC)" $(TEST_HC_OPTS) T22807A.hs -fhide-source-paths -fwrite-if-simplified-core -fbyte-code-and-object-code -fno-omit-interface-pragmas -fprefer-byte-code + "$(TEST_HC)" $(TEST_HC_OPTS) T22807B.hs -fhide-source-paths -fwrite-if-simplified-core -fprefer-byte-code -fbyte-code-and-object-code -fno-omit-interface-pragmas + +T22807_ghci: clean + "$(TEST_HC)" $(TEST_HC_OPTS) T22807_ghci.hs -fno-full-laziness -fhide-source-paths -fwrite-if-simplified-core -O2 -dynamic -v0 + "$(TEST_HC)" $(TEST_HC_OPTS) -v0 --interactive -fhide-source-paths -fno-full-laziness < T22807_ghci.script ===================================== testsuite/tests/driver/fat-iface/T22807.stdout ===================================== @@ -0,0 +1,2 @@ +[1 of 1] Compiling T22807A +[2 of 2] Compiling T22807B ===================================== testsuite/tests/driver/fat-iface/T22807A.hs ===================================== @@ -0,0 +1,6 @@ +module T22807A where + +xs :: [a] +xs = [] + + ===================================== testsuite/tests/driver/fat-iface/T22807B.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE TemplateHaskell #-} +module T22807B where +import T22807A + +$(pure xs) ===================================== testsuite/tests/driver/fat-iface/T22807_ghci.hs ===================================== @@ -0,0 +1,8 @@ +module T22807_ghci where + + +foo b = + let x = Just [1..1000] + in if b + then Left x + else Right x ===================================== testsuite/tests/driver/fat-iface/T22807_ghci.script ===================================== @@ -0,0 +1,6 @@ +:l T22807_ghci.hs + +import T22807_ghci +import Data.Either + +isLeft (foo True) ===================================== testsuite/tests/driver/fat-iface/T22807_ghci.stdout ===================================== @@ -0,0 +1 @@ +True ===================================== testsuite/tests/driver/fat-iface/all.T ===================================== @@ -15,5 +15,9 @@ test('fat013', [req_th, extra_files(['FatTH.hs', 'FatQuote.hs'])], multimod_comp # When using interpreter should not produce objects test('fat014', [req_th, extra_files(['FatTH.hs', 'FatQuote.hs']), extra_run_opts('-fno-code')], ghci_script, ['fat014.script']) test('fat015', [req_th, unless(ghc_dynamic(), skip), extra_files(['FatQuote.hs', 'FatQuote1.hs', 'FatQuote2.hs', 'FatTH1.hs', 'FatTH2.hs', 'FatTHTop.hs'])], multimod_compile, ['FatTHTop', '-fno-code -fwrite-interface']) +test('T22807', [req_th, unless(ghc_dynamic(), skip), extra_files(['T22807A.hs', 'T22807B.hs'])] + , makefile_test, ['T22807']) +test('T22807_ghci', [req_th, unless(ghc_dynamic(), skip), extra_files(['T22807_ghci.hs'])] + , makefile_test, ['T22807_ghci']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b6cbab39dc318a9c947d2d729101c7ab89dd1f78...a3c933a38735870f75983a57a1ada63b7e8eff2c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b6cbab39dc318a9c947d2d729101c7ab89dd1f78...a3c933a38735870f75983a57a1ada63b7e8eff2c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 00:00:09 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Thu, 02 Feb 2023 19:00:09 -0500 Subject: [Git][ghc/ghc][wip/9.2.6-backports] 21 commits: Truncate eventlog event for large payload (#20221) Message-ID: <63dc4e89387df_1108fe54ddcd0339294@gitlab.mail> Zubin pushed to branch wip/9.2.6-backports at Glasgow Haskell Compiler / GHC Commits: 072e08c7 by Ian-Woo Kim at 2023-02-03T05:12:58+05:30 Truncate eventlog event for large payload (#20221) RTS eventlog events for postCapsetVecEvent are truncated if payload is larger than EVENT_PAYLOAD_SIZE_MAX Previously, postCapsetVecEvent records eventlog event with payload of variable size larger than EVENT_PAYLOAD_SIZE_MAX (2^16) without any validation, resulting in corrupted data. For example, this happens when a Haskell binary is invoked with very long command line arguments exceeding 2^16 bytes (see #20221). Now we check the size of accumulated payload messages incrementally, and truncate the message just before the payload size exceeds EVENT_PAYLOAD_SIZE_MAX. RTS will warn the user with a message showing how many arguments are truncated. (cherry picked from commit 2057c77d08cb8422857d182a3691f98dccd0c7d6) - - - - - 7ff3ff93 by Simon Peyton Jones at 2023-02-03T05:12:58+05:30 Make FloatIn robust to shadowing This MR fixes #22622. See the new Note [Shadowing and name capture] I did a bit of refactoring in sepBindsByDropPoint too. The bug doesn't manifest in HEAD, but it did show up in 9.4, so we should backport this patch to 9.4 (cherry picked from commit 6206cb9287f3f6e70c669660a646a65274870d2b) - - - - - d352fdf2 by Ben Gamari at 2023-02-03T05:12:58+05:30 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. (cherry picked from commit f891a442046d8a5ebf4d4777847880ce06752b18) - - - - - c2611ad7 by Ben Gamari at 2023-02-03T05:12:58+05:30 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. (cherry picked from commit b13c6ea5d4b64841164f8cc58d6c6f3de390f2ed) - - - - - 35b3ef63 by Oleg Grenrus at 2023-02-03T05:12:58+05:30 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general (cherry picked from commit 1b812b6973a25cb1962e2fc543d2c4ed3cf31f3c) - - - - - 7f86f967 by Zubin Duggal at 2023-02-03T05:12:58+05:30 Document #22255 and #22468 in bugs.rst - - - - - 799690c8 by Simon Peyton Jones at 2023-02-03T05:12:58+05:30 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 (cherry picked from commit 3d55d8ab51ece43c51055c43c9e7aba77cce46c0) - - - - - 9ffc7893 by Simon Peyton Jones at 2023-02-03T05:12:58+05:30 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. (cherry picked from commit e193e53790dd5886feea3cf4c9c17625d188291b) - - - - - a6a3dfac by Sebastian Graf at 2023-02-03T05:12:58+05:30 DmdAnal: Don't panic in addCaseBndrDmd (#22039) Rather conservatively return Top. See Note [Untyped demand on case-alternative binders]. I also factored `addCaseBndrDmd` into two separate functions `scrutSubDmd` and `fieldBndrDmds`. Fixes #22039. (cherry picked from commit d2be80fd9b222963e8dd09a30f78c106e00da7f9) - - - - - f973dc6d by Matthew Pickering at 2023-02-03T05:12:58+05:30 ApplicativeDo: Set pattern location before running exhaustiveness checker This improves the error messages of the exhaustiveness checker when checking statements which have been moved around with ApplicativeDo. Before: Test.hs:2:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 2 | let x = () | ^^^^^^^^^^ After: Test.hs:4:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 4 | ~(Just res1) <- seq x (pure $ Nothing @()) | Fixes #22483 (cherry picked from commit 74c767df770766d8d52e87b9ff7da10f94620a91) (cherry picked from commit 51c6051bcc405bc1dbddd450ade949acd70db6b8) - - - - - 022d9695 by Andreas Klebinger at 2023-02-03T05:12:58+05:30 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- (cherry picked from commit 08ba87200ff068aa37cac082e61ee7e2d534daf5) - - - - - 4797a985 by Matthew Pickering at 2023-02-03T05:12:58+05:30 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s (cherry picked from commit a960ca817d6ad0109ea6edda50da3902cc538e86) - - - - - eb1984c0 by Matthew Pickering at 2023-02-03T05:12:58+05:30 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. (cherry picked from commit 734847108420cf826a807c30ad54651659cf3a08) - - - - - 31c921a8 by Matthew Pickering at 2023-02-03T05:12:59+05:30 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes (cherry picked from commit 8c0ea25fb4a27d4729aabf73f4c00b912bb0c58d) - - - - - 83212a38 by Cheng Shao at 2023-02-03T05:12:59+05:30 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. (cherry picked from commit c45a5fffef2c76efbf5d3a009c3f6d0244a63f0d) - - - - - 68af770d by Ben Gamari at 2023-02-03T05:12:59+05:30 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. (cherry picked from commit be417a47c7695998dea0adc05489a7b8838a78b6) - - - - - 1cb728e2 by Ben Gamari at 2023-02-03T05:12:59+05:30 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. (cherry picked from commit 30989d137b8f3a8fddbfd116e04b48f23c24f86c) - - - - - c581ae50 by Ben Gamari at 2023-02-03T05:12:59+05:30 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. (cherry picked from commit 7566fd9de38c67360c090f828923d41587af519c) - - - - - 8e476ba0 by Ben Gamari at 2023-02-03T05:12:59+05:30 testsuite: Add regression test for #22798 (cherry picked from commit 2cb500a5ee1a31dfe1a2cdd71f175442026eb082) - - - - - 43f5f901 by Zubin Duggal at 2023-02-03T05:12:59+05:30 hadrian: enable -haddock in perf flavour (#22734) - - - - - f9cd3cdb by Zubin Duggal at 2023-02-03T05:20:49+05:30 Testsuite fixes - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/HsToCore/Expr.hs - compiler/cbits/keepCAFsForGHCi.c - compiler/ghc.mk - configure.ac - docs/users_guide/bugs.rst - hadrian/src/Settings/Flavours/Performance.hs - libraries/ghc-bignum/gmp/gmp-tarballs - + m4/fp_ld_no_fixup_chains.m4 - rts/eventlog/EventLog.c - + testsuite/tests/ado/T22483.hs - + testsuite/tests/ado/T22483.stderr - testsuite/tests/ado/all.T - + testsuite/tests/codeGen/should_run/T22798.hs - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/ghci/T16392/T16392.script - testsuite/tests/ghci/linking/dyn/Makefile - testsuite/tests/ghci/scripts/T9881.stdout - testsuite/tests/ghci/scripts/ghci025.stdout - testsuite/tests/rts/T18623/all.T - + testsuite/tests/safeHaskell/warnings/Makefile - + testsuite/tests/safeHaskell/warnings/T22728.hs - + testsuite/tests/safeHaskell/warnings/T22728.stderr - + testsuite/tests/safeHaskell/warnings/T22728_B.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1f5fb83f3924b04fb0eb3bc335dc0b54e3249c28...f9cd3cdb395941fab6b75d673b74b340dd6a6a51 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1f5fb83f3924b04fb0eb3bc335dc0b54e3249c28...f9cd3cdb395941fab6b75d673b74b340dd6a6a51 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 02:02:43 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 02 Feb 2023 21:02:43 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Enable tables next to code for LoongArch64 Message-ID: <63dc6b43253cc_1108fe722f554366812@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 190f4552 by lrzlin at 2023-02-02T21:02:23-05:00 Enable tables next to code for LoongArch64 - - - - - 9e3d1570 by Wander Hillen at 2023-02-02T21:02:25-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 961c220b by Ben Gamari at 2023-02-02T21:02:26-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 47d0fba8 by Bodigrim at 2023-02-02T21:02:30-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 9 changed files: - compiler/GHC/CmmToLlvm/Mangler.hs - compiler/ghc.cabal.in - libraries/base/GHC/IO/Handle/Types.hs - libraries/containers - libraries/ghci/GHCi/InfoTable.hsc - m4/ghc_tables_next_to_code.m4 - rts/posix/Ticker.c - rts/posix/ticker/Pthread.c - + rts/posix/ticker/TimerFd.c Changes: ===================================== compiler/GHC/CmmToLlvm/Mangler.hs ===================================== @@ -38,7 +38,7 @@ llvmFixupAsm platform f1 f2 = {-# SCC "llvm_mangler" #-} -- | These are the rewrites that the mangler will perform rewrites :: [Rewrite] -rewrites = [rewriteSymType, rewriteAVX, rewriteCall] +rewrites = [rewriteSymType, rewriteAVX, rewriteCall, rewriteJump] type Rewrite = Platform -> B.ByteString -> Maybe B.ByteString @@ -123,6 +123,29 @@ rewriteCall platform l removePlt = replaceOnce (B.pack "@plt") (B.pack "") appendInsn i = (`B.append` B.pack ("\n\t" ++ i)) +-- | This rewrites bl and b jump inst to avoid creating PLT entries for +-- functions on loongarch64, because there is no separate call instruction +-- for function calls in loongarch64. Also, this replacement will load +-- the function address from the GOT, which is resolved to point to the +-- real address of the function. +rewriteJump :: Rewrite +rewriteJump platform l + | not isLoongArch64 = Nothing + | isBL l = Just $ replaceJump "bl" "$ra" "$ra" l + | isB l = Just $ replaceJump "b" "$zero" "$t0" l + | otherwise = Nothing + where + isLoongArch64 = platformArch platform == ArchLoongArch64 + isBL = B.isPrefixOf (B.pack "bl\t") + isB = B.isPrefixOf (B.pack "b\t") + + replaceJump jump rd rj l = + appendInsn ("jirl" ++ "\t" ++ rd ++ ", " ++ rj ++ ", 0") $ removeBracket $ + replaceOnce (B.pack (jump ++ "\t%plt(")) (B.pack ("la\t" ++ rj ++ ", ")) l + where + removeBracket = replaceOnce (B.pack ")") (B.pack "") + appendInsn i = (`B.append` B.pack ("\n\t" ++ i)) + -- | @replaceOnce match replace bs@ replaces the first occurrence of the -- substring @match@ in @bs@ with @replace at . replaceOnce :: B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString ===================================== compiler/ghc.cabal.in ===================================== @@ -557,6 +557,7 @@ Library GHC.Platform.ARM GHC.Platform.AArch64 GHC.Platform.Constants + GHC.Platform.LoongArch64 GHC.Platform.NoRegs GHC.Platform.PPC GHC.Platform.Profile @@ -564,7 +565,6 @@ Library GHC.Platform.Reg.Class GHC.Platform.Regs GHC.Platform.RISCV64 - GHC.Platform.LoongArch64 GHC.Platform.S390X GHC.Platform.Wasm32 GHC.Platform.Ways ===================================== libraries/base/GHC/IO/Handle/Types.hs ===================================== @@ -124,11 +124,11 @@ data Handle__ Handle__ { haDevice :: !dev, haType :: HandleType, -- type (read/write/append etc.) - haByteBuffer :: !(IORef (Buffer Word8)), -- See [note Buffering Implementation] + haByteBuffer :: !(IORef (Buffer Word8)), -- See Note [Buffering Implementation] haBufferMode :: BufferMode, haLastDecode :: !(IORef (dec_state, Buffer Word8)), -- ^ The byte buffer just before we did our last batch of decoding. - haCharBuffer :: !(IORef (Buffer CharBufElem)), -- See [note Buffering Implementation] + haCharBuffer :: !(IORef (Buffer CharBufElem)), -- See Note [Buffering Implementation] haBuffers :: !(IORef (BufferList CharBufElem)), -- spare buffers haEncoder :: Maybe (TextEncoder enc_state), haDecoder :: Maybe (TextDecoder dec_state), @@ -261,13 +261,13 @@ data BufferMode ) {- -[note Buffering Implementation] - +Note [Buffering Implementation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Each Handle has two buffers: a byte buffer (haByteBuffer) and a Char buffer (haCharBuffer). -[note Buffered Reading] - +Note [Buffered Reading] +~~~~~~~~~~~~~~~~~~~~~~~ For read Handles, bytes are read into the byte buffer, and immediately decoded into the Char buffer (see GHC.IO.Handle.Internals.readTextDevice). The only way there might be @@ -279,8 +279,8 @@ reading data into a Handle. When reading, we can always just read all the data there is available without blocking, decode it into the Char buffer, and then provide it immediately to the caller. -[note Buffered Writing] - +Note [Buffered Writing] +~~~~~~~~~~~~~~~~~~~~~~~ Characters are written into the Char buffer by e.g. hPutStr. At the end of the operation, or when the char buffer is full, the buffer is decoded to the byte buffer (see writeCharBuffer). This is so that we @@ -288,8 +288,8 @@ can detect encoding errors at the right point. Hence, the Char buffer is always empty between Handle operations. -[note Buffer Sizing] - +Note [Buffer Sizing] +~~~~~~~~~~~~~~~~~~~~ The char buffer is always a default size (dEFAULT_CHAR_BUFFER_SIZE). The byte buffer size is chosen by the underlying device (via its IODevice.newBuffer). Hence the size of these buffers is not under @@ -322,8 +322,8 @@ writeCharBuffer, which checks whether the buffer should be flushed according to the current buffering mode. Additionally, we look for newlines and flush if the mode is LineBuffering. -[note Buffer Flushing] - +Note [Buffer Flushing] +~~~~~~~~~~~~~~~~~~~~~~ ** Flushing the Char buffer We must be able to flush the Char buffer, in order to implement ===================================== libraries/containers ===================================== @@ -1 +1 @@ -Subproject commit fbafcf704f0febd9ddac84dbe00ae3787af43550 +Subproject commit 9f4a93604c66a5e605ce46fc30003b71802b3cfd ===================================== libraries/ghci/GHCi/InfoTable.hsc ===================================== @@ -228,6 +228,15 @@ mkJumpToAddr a = case hostPlatformArch of , fromIntegral w64 , fromIntegral (w64 `shiftR` 32) ] + ArchLoongArch64 -> pure $ + let w64 = fromIntegral (funPtrToInt a) :: Word64 + in Right [ 0x1c00000c -- pcaddu12i $t0,0 + , 0x28c0418c -- ld.d $t0,$t0,16 + , 0x4c000180 -- jr $t0 + , 0x03400000 -- nop + , fromIntegral w64 + , fromIntegral (w64 `shiftR` 32) ] + arch -> -- The arch isn't supported. You either need to add your architecture as a -- distinct case, or use non-TABLES_NEXT_TO_CODE mode. ===================================== m4/ghc_tables_next_to_code.m4 ===================================== @@ -17,7 +17,7 @@ AC_DEFUN([GHC_TABLES_NEXT_TO_CODE], case "$Unregisterised" in NO) case "$TargetArch" in - ia64|powerpc64|powerpc64le|s390x|wasm32|loongarch64) + ia64|powerpc64|powerpc64le|s390x|wasm32) TablesNextToCodeDefault=NO AC_MSG_RESULT([no]) ;; ===================================== rts/posix/Ticker.c ===================================== @@ -65,13 +65,17 @@ * On Linux we can use timerfd_* (introduced in Linux * 2.6.25) and a thread instead of alarm signals. It avoids the risk of * interrupting syscalls (see #10840) and the risk of being accidentally - * modified in user code using signals. + * modified in user code using signals. NetBSD has also added timerfd + * support since version 10. + * + * For older version of linux/netbsd without timerfd we fall back to the + * pthread based implementation. */ -#if defined(linux_HOST_OS) && HAVE_SYS_TIMERFD_H -#define USE_PTHREAD_FOR_ITIMER +#if HAVE_SYS_TIMERFD_H +#define USE_TIMERFD_FOR_ITIMER #endif -#if defined(freebsd_HOST_OS) +#if defined(linux_HOST_OS) #define USE_PTHREAD_FOR_ITIMER #endif @@ -79,6 +83,10 @@ #define USE_PTHREAD_FOR_ITIMER #endif +#if defined(freebsd_HOST_OS) +#define USE_PTHREAD_FOR_ITIMER +#endif + #if defined(solaris2_HOST_OS) /* USE_TIMER_CREATE is usually disabled for Solaris. In fact it is supported well on this OS, but requires additional privilege. When @@ -98,7 +106,9 @@ ghc-stage2: timer_create: Not owner #endif /* solaris2_HOST_OS */ // Select the variant to use -#if defined(USE_PTHREAD_FOR_ITIMER) +#if defined(USE_TIMERFD_FOR_ITIMER) +#include "ticker/TimerFd.c" +#elif defined(USE_PTHREAD_FOR_ITIMER) #include "ticker/Pthread.c" #elif defined(USE_TIMER_CREATE) #include "ticker/TimerCreate.c" ===================================== rts/posix/ticker/Pthread.c ===================================== @@ -63,13 +63,6 @@ #include #include -#if defined(HAVE_SYS_TIMERFD_H) -#include -#define USE_TIMERFD_FOR_ITIMER 1 -#else -#define USE_TIMERFD_FOR_ITIMER 0 -#endif - /* * TFD_CLOEXEC has been added in Linux 2.6.26. * If it is not available, we use fcntl(F_SETFD). @@ -93,61 +86,16 @@ static Condition start_cond; static Mutex mutex; 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) { - if (poll(pollfds, 2, -1) == -1) { - sysErrorBelch("Ticker: poll failed: %s", strerror(errno)); - } - - // 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) { - sysErrorBelch("Ticker: sleep failed: %s", strerror(errno)); - } + if (rtsSleep(itimer_interval) != 0) { + sysErrorBelch("Ticker: sleep failed: %s", strerror(errno)); } // first try a cheap test @@ -164,10 +112,6 @@ static void *itimer_thread_func(void *_handle_tick) } } - if (USE_TIMERFD_FOR_ITIMER) { - close(timerfd); - } - return NULL; } @@ -186,39 +130,6 @@ initTicker (Time interval, TickProc handle_tick) initCondition(&start_cond); initMutex(&mutex); - /* Open the file descriptor for the timer synchronously. - * - * We used to do it in itimer_thread_func (i.e. in the timer thread) but it - * meant that some user code could run before it and get confused by the - * allocation of the timerfd. - * - * See hClose002 which unsafely closes a file descriptor twice expecting an - * exception the second time: it sometimes failed when the second call to - * "close" closed our own timerfd which inadvertently reused the same file - * descriptor closed by the first call! (see #20618) - */ -#if USE_TIMERFD_FOR_ITIMER - struct itimerspec it; - it.it_value.tv_sec = TimeToSeconds(itimer_interval); - it.it_value.tv_nsec = TimeToNS(itimer_interval) % 1000000000; - it.it_interval = it.it_value; - - timerfd = timerfd_create(CLOCK_MONOTONIC, TFD_CLOEXEC); - if (timerfd == -1) { - barf("timerfd_create: %s", strerror(errno)); - } - if (!TFD_CLOEXEC) { - fcntl(timerfd, F_SETFD, FD_CLOEXEC); - } - if (timerfd_settime(timerfd, 0, &it, NULL)) { - barf("timerfd_settime: %s", strerror(errno)); - } - - if (pipe(pipefds) < 0) { - barf("pipe: %s", strerror(errno)); - } -#endif - /* * Create the thread with all blockable signals blocked, leaving signal * handling to the main and/or other threads. This is especially useful in @@ -269,21 +180,9 @@ 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 { ===================================== rts/posix/ticker/TimerFd.c ===================================== @@ -0,0 +1,280 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1995-2023 + * + * Interval timer for profiling and pre-emptive scheduling. + * + * ---------------------------------------------------------------------------*/ + +/* + * We use a realtime timer by default. I found this much more + * reliable than a CPU timer: + * + * Experiments with different frequencies: using + * CLOCK_REALTIME/CLOCK_MONOTONIC on Linux 2.6.32, + * 1000us has <1% impact on runtime + * 100us has ~2% impact on runtime + * 10us has ~40% impact on runtime + * + * using CLOCK_PROCESS_CPUTIME_ID on Linux 2.6.32, + * I cannot get it to tick faster than 10ms (10000us) + * which isn't great for profiling. + * + * In the threaded RTS, we can't tick in CPU time because the thread + * which has the virtual timer might be idle, so the tick would never + * fire. Therefore we used to tick in realtime in the threaded RTS and + * in CPU time otherwise, but now we always tick in realtime, for + * several reasons: + * + * - resolution (see above) + * - consistency (-threaded is the same as normal) + * - more consistency: Windows only has a realtime timer + * + * Note we want to use CLOCK_MONOTONIC rather than CLOCK_REALTIME, + * because the latter may jump around (NTP adjustments, leap seconds + * etc.). + */ + +#include "rts/PosixSource.h" +#include "Rts.h" + +#include "Ticker.h" +#include "RtsUtils.h" +#include "Proftimer.h" +#include "Schedule.h" +#include "posix/Clock.h" +#include + +#include +#if HAVE_SYS_TIME_H +# include +#endif + +#if defined(HAVE_SIGNAL_H) +# include +#endif + +#include + +#include +#if defined(HAVE_PTHREAD_NP_H) +#include +#endif +#include +#include + +#include + + +/* + * TFD_CLOEXEC has been added in Linux 2.6.26. + * If it is not available, we use fcntl(F_SETFD). + */ +#if !defined(TFD_CLOEXEC) +#define TFD_CLOEXEC 0 +#endif + +static Time itimer_interval = DEFAULT_TICK_INTERVAL; + +// Should we be firing ticks? +// Writers to this must hold the mutex below. +static bool stopped = false; + +// should the ticker thread exit? +// This can be set without holding the mutex. +static bool exited = true; + +// Signaled when we want to (re)start the timer +static Condition start_cond; +static Mutex mutex; +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]; + + pollfds[0].fd = pipefds[0]; + pollfds[0].events = POLLIN; + pollfds[1].fd = timerfd; + pollfds[1].events = POLLIN; + + // 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 (poll(pollfds, 2, -1) == -1) { + sysErrorBelch("Ticker: poll failed: %s", strerror(errno)); + } + + // 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); + } + } + + // first try a cheap test + TSAN_ANNOTATE_BENIGN_RACE(&stopped, "itimer_thread_func"); + if (RELAXED_LOAD(&stopped)) { + OS_ACQUIRE_LOCK(&mutex); + // should we really stop? + if (stopped) { + waitCondition(&start_cond, &mutex); + } + OS_RELEASE_LOCK(&mutex); + } else { + handle_tick(0); + } + } + + close(timerfd); + return NULL; +} + +void +initTicker (Time interval, TickProc handle_tick) +{ + itimer_interval = interval; + stopped = true; + exited = false; +#if defined(HAVE_SIGNAL_H) + sigset_t mask, omask; + int sigret; +#endif + int ret; + + initCondition(&start_cond); + initMutex(&mutex); + + /* Open the file descriptor for the timer synchronously. + * + * We used to do it in itimer_thread_func (i.e. in the timer thread) but it + * meant that some user code could run before it and get confused by the + * allocation of the timerfd. + * + * See hClose002 which unsafely closes a file descriptor twice expecting an + * exception the second time: it sometimes failed when the second call to + * "close" closed our own timerfd which inadvertently reused the same file + * descriptor closed by the first call! (see #20618) + */ + struct itimerspec it; + it.it_value.tv_sec = TimeToSeconds(itimer_interval); + it.it_value.tv_nsec = TimeToNS(itimer_interval) % 1000000000; + it.it_interval = it.it_value; + + timerfd = timerfd_create(CLOCK_MONOTONIC, TFD_CLOEXEC); + if (timerfd == -1) { + barf("timerfd_create: %s", strerror(errno)); + } + if (!TFD_CLOEXEC) { + fcntl(timerfd, F_SETFD, FD_CLOEXEC); + } + if (timerfd_settime(timerfd, 0, &it, NULL)) { + barf("timerfd_settime: %s", strerror(errno)); + } + + if (pipe(pipefds) < 0) { + barf("pipe: %s", strerror(errno)); + } + + /* + * Create the thread with all blockable signals blocked, leaving signal + * handling to the main and/or other threads. This is especially useful in + * the non-threaded runtime, where applications might expect sigprocmask(2) + * to effectively block signals. + */ +#if defined(HAVE_SIGNAL_H) + sigfillset(&mask); + sigret = pthread_sigmask(SIG_SETMASK, &mask, &omask); +#endif + ret = createAttachedOSThread(&thread, "ghc_ticker", itimer_thread_func, (void*)handle_tick); +#if defined(HAVE_SIGNAL_H) + if (sigret == 0) + pthread_sigmask(SIG_SETMASK, &omask, NULL); +#endif + + if (ret != 0) { + barf("Ticker: Failed to spawn thread: %s", strerror(errno)); + } +} + +void +startTicker(void) +{ + OS_ACQUIRE_LOCK(&mutex); + RELAXED_STORE(&stopped, false); + signalCondition(&start_cond); + OS_RELEASE_LOCK(&mutex); +} + +/* There may be at most one additional tick fired after a call to this */ +void +stopTicker(void) +{ + OS_ACQUIRE_LOCK(&mutex); + RELAXED_STORE(&stopped, true); + OS_RELEASE_LOCK(&mutex); +} + +/* There may be at most one additional tick fired after a call to this */ +void +exitTicker (bool wait) +{ + ASSERT(!SEQ_CST_LOAD(&exited)); + SEQ_CST_STORE(&exited, true); + // ensure that ticker wakes up if stopped + startTicker(); + + // wait for ticker to terminate if necessary + if (wait) { + // 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)); + } + + if (pthread_join(thread, NULL)) { + sysErrorBelch("Ticker: Failed to join: %s", strerror(errno)); + } + + // 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]); + + closeMutex(&mutex); + closeCondition(&start_cond); + } else { + pthread_detach(thread); + } +} + +int +rtsTimerSignal(void) +{ + return SIGALRM; +} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a3c933a38735870f75983a57a1ada63b7e8eff2c...47d0fba86cc11886b9c39f477392fad95bfa7dda -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a3c933a38735870f75983a57a1ada63b7e8eff2c...47d0fba86cc11886b9c39f477392fad95bfa7dda You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 04:18:35 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Thu, 02 Feb 2023 23:18:35 -0500 Subject: [Git][ghc/ghc][wip/js-fileStat] Re-enable unexpected passes fixed by JS FileStat changes Message-ID: <63dc8b1bc3bba_1108fe526203872e4@gitlab.mail> Josh Meredith pushed to branch wip/js-fileStat at Glasgow Haskell Compiler / GHC Commits: 7ea76a64 by Josh Meredith at 2023-02-03T04:17:58+00:00 Re-enable unexpected passes fixed by JS FileStat changes - - - - - 3 changed files: - testsuite/tests/callarity/unittest/all.T - testsuite/tests/corelint/all.T - testsuite/tests/ghc-api/all.T Changes: ===================================== testsuite/tests/callarity/unittest/all.T ===================================== @@ -5,4 +5,4 @@ setTestOpts(f) setTestOpts(extra_hc_opts('-package ghc')) setTestOpts(extra_run_opts('"' + config.libdir + '"')) -test('CallArity1', js_broken(22362), compile_and_run, ['']) +test('CallArity1', normal, compile_and_run, ['']) ===================================== testsuite/tests/corelint/all.T ===================================== @@ -7,6 +7,6 @@ test('T21152', normal, compile, ['-g3']) setTestOpts(extra_hc_opts('-package ghc')) setTestOpts(extra_run_opts('"' + config.libdir + '"')) -test('LintEtaExpand', js_broken(22362), compile_and_run, ['']) +test('LintEtaExpand', normal, compile_and_run, ['']) ## These tests use the GHC API. ## Test cases which don't use the GHC API should be added nearer the top. ===================================== testsuite/tests/ghc-api/all.T ===================================== @@ -4,14 +4,14 @@ test('T8639_api', req_rts_linker, makefile_test, ['T8639_api']) test('T8628', req_rts_linker, makefile_test, ['T8628']) -test('T9595', [extra_run_opts('"' + config.libdir + '"'), js_broken(22362)], +test('T9595', [extra_run_opts('"' + config.libdir + '"')], compile_and_run, ['-package ghc']) test('T10508_api', [ extra_run_opts('"' + config.libdir + '"'), req_rts_linker ], compile_and_run, ['-package ghc']) -test('T10942', [extra_run_opts('"' + config.libdir + '"'), js_broken(22362)], +test('T10942', [extra_run_opts('"' + config.libdir + '"')], compile_and_run, ['-package ghc']) test('T9015', extra_run_opts('"' + config.libdir + '"'), View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7ea76a64bc90fe95b4ab830685338163dc0c3a91 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7ea76a64bc90fe95b4ab830685338163dc0c3a91 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 04:43:05 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 02 Feb 2023 23:43:05 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Enable tables next to code for LoongArch64 Message-ID: <63dc90d91f09d_1108fe5260c38951@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b6d40c6d by lrzlin at 2023-02-02T23:42:46-05:00 Enable tables next to code for LoongArch64 - - - - - c46cff0c by Wander Hillen at 2023-02-02T23:42:48-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 3b2bbe50 by Ben Gamari at 2023-02-02T23:42:49-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 9ad7c495 by Bodigrim at 2023-02-02T23:42:50-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 9 changed files: - compiler/GHC/CmmToLlvm/Mangler.hs - compiler/ghc.cabal.in - libraries/base/GHC/IO/Handle/Types.hs - libraries/containers - libraries/ghci/GHCi/InfoTable.hsc - m4/ghc_tables_next_to_code.m4 - rts/posix/Ticker.c - rts/posix/ticker/Pthread.c - + rts/posix/ticker/TimerFd.c Changes: ===================================== compiler/GHC/CmmToLlvm/Mangler.hs ===================================== @@ -38,7 +38,7 @@ llvmFixupAsm platform f1 f2 = {-# SCC "llvm_mangler" #-} -- | These are the rewrites that the mangler will perform rewrites :: [Rewrite] -rewrites = [rewriteSymType, rewriteAVX, rewriteCall] +rewrites = [rewriteSymType, rewriteAVX, rewriteCall, rewriteJump] type Rewrite = Platform -> B.ByteString -> Maybe B.ByteString @@ -123,6 +123,29 @@ rewriteCall platform l removePlt = replaceOnce (B.pack "@plt") (B.pack "") appendInsn i = (`B.append` B.pack ("\n\t" ++ i)) +-- | This rewrites bl and b jump inst to avoid creating PLT entries for +-- functions on loongarch64, because there is no separate call instruction +-- for function calls in loongarch64. Also, this replacement will load +-- the function address from the GOT, which is resolved to point to the +-- real address of the function. +rewriteJump :: Rewrite +rewriteJump platform l + | not isLoongArch64 = Nothing + | isBL l = Just $ replaceJump "bl" "$ra" "$ra" l + | isB l = Just $ replaceJump "b" "$zero" "$t0" l + | otherwise = Nothing + where + isLoongArch64 = platformArch platform == ArchLoongArch64 + isBL = B.isPrefixOf (B.pack "bl\t") + isB = B.isPrefixOf (B.pack "b\t") + + replaceJump jump rd rj l = + appendInsn ("jirl" ++ "\t" ++ rd ++ ", " ++ rj ++ ", 0") $ removeBracket $ + replaceOnce (B.pack (jump ++ "\t%plt(")) (B.pack ("la\t" ++ rj ++ ", ")) l + where + removeBracket = replaceOnce (B.pack ")") (B.pack "") + appendInsn i = (`B.append` B.pack ("\n\t" ++ i)) + -- | @replaceOnce match replace bs@ replaces the first occurrence of the -- substring @match@ in @bs@ with @replace at . replaceOnce :: B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString ===================================== compiler/ghc.cabal.in ===================================== @@ -557,6 +557,7 @@ Library GHC.Platform.ARM GHC.Platform.AArch64 GHC.Platform.Constants + GHC.Platform.LoongArch64 GHC.Platform.NoRegs GHC.Platform.PPC GHC.Platform.Profile @@ -564,7 +565,6 @@ Library GHC.Platform.Reg.Class GHC.Platform.Regs GHC.Platform.RISCV64 - GHC.Platform.LoongArch64 GHC.Platform.S390X GHC.Platform.Wasm32 GHC.Platform.Ways ===================================== libraries/base/GHC/IO/Handle/Types.hs ===================================== @@ -124,11 +124,11 @@ data Handle__ Handle__ { haDevice :: !dev, haType :: HandleType, -- type (read/write/append etc.) - haByteBuffer :: !(IORef (Buffer Word8)), -- See [note Buffering Implementation] + haByteBuffer :: !(IORef (Buffer Word8)), -- See Note [Buffering Implementation] haBufferMode :: BufferMode, haLastDecode :: !(IORef (dec_state, Buffer Word8)), -- ^ The byte buffer just before we did our last batch of decoding. - haCharBuffer :: !(IORef (Buffer CharBufElem)), -- See [note Buffering Implementation] + haCharBuffer :: !(IORef (Buffer CharBufElem)), -- See Note [Buffering Implementation] haBuffers :: !(IORef (BufferList CharBufElem)), -- spare buffers haEncoder :: Maybe (TextEncoder enc_state), haDecoder :: Maybe (TextDecoder dec_state), @@ -261,13 +261,13 @@ data BufferMode ) {- -[note Buffering Implementation] - +Note [Buffering Implementation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Each Handle has two buffers: a byte buffer (haByteBuffer) and a Char buffer (haCharBuffer). -[note Buffered Reading] - +Note [Buffered Reading] +~~~~~~~~~~~~~~~~~~~~~~~ For read Handles, bytes are read into the byte buffer, and immediately decoded into the Char buffer (see GHC.IO.Handle.Internals.readTextDevice). The only way there might be @@ -279,8 +279,8 @@ reading data into a Handle. When reading, we can always just read all the data there is available without blocking, decode it into the Char buffer, and then provide it immediately to the caller. -[note Buffered Writing] - +Note [Buffered Writing] +~~~~~~~~~~~~~~~~~~~~~~~ Characters are written into the Char buffer by e.g. hPutStr. At the end of the operation, or when the char buffer is full, the buffer is decoded to the byte buffer (see writeCharBuffer). This is so that we @@ -288,8 +288,8 @@ can detect encoding errors at the right point. Hence, the Char buffer is always empty between Handle operations. -[note Buffer Sizing] - +Note [Buffer Sizing] +~~~~~~~~~~~~~~~~~~~~ The char buffer is always a default size (dEFAULT_CHAR_BUFFER_SIZE). The byte buffer size is chosen by the underlying device (via its IODevice.newBuffer). Hence the size of these buffers is not under @@ -322,8 +322,8 @@ writeCharBuffer, which checks whether the buffer should be flushed according to the current buffering mode. Additionally, we look for newlines and flush if the mode is LineBuffering. -[note Buffer Flushing] - +Note [Buffer Flushing] +~~~~~~~~~~~~~~~~~~~~~~ ** Flushing the Char buffer We must be able to flush the Char buffer, in order to implement ===================================== libraries/containers ===================================== @@ -1 +1 @@ -Subproject commit fbafcf704f0febd9ddac84dbe00ae3787af43550 +Subproject commit 9f4a93604c66a5e605ce46fc30003b71802b3cfd ===================================== libraries/ghci/GHCi/InfoTable.hsc ===================================== @@ -228,6 +228,15 @@ mkJumpToAddr a = case hostPlatformArch of , fromIntegral w64 , fromIntegral (w64 `shiftR` 32) ] + ArchLoongArch64 -> pure $ + let w64 = fromIntegral (funPtrToInt a) :: Word64 + in Right [ 0x1c00000c -- pcaddu12i $t0,0 + , 0x28c0418c -- ld.d $t0,$t0,16 + , 0x4c000180 -- jr $t0 + , 0x03400000 -- nop + , fromIntegral w64 + , fromIntegral (w64 `shiftR` 32) ] + arch -> -- The arch isn't supported. You either need to add your architecture as a -- distinct case, or use non-TABLES_NEXT_TO_CODE mode. ===================================== m4/ghc_tables_next_to_code.m4 ===================================== @@ -17,7 +17,7 @@ AC_DEFUN([GHC_TABLES_NEXT_TO_CODE], case "$Unregisterised" in NO) case "$TargetArch" in - ia64|powerpc64|powerpc64le|s390x|wasm32|loongarch64) + ia64|powerpc64|powerpc64le|s390x|wasm32) TablesNextToCodeDefault=NO AC_MSG_RESULT([no]) ;; ===================================== rts/posix/Ticker.c ===================================== @@ -65,13 +65,17 @@ * On Linux we can use timerfd_* (introduced in Linux * 2.6.25) and a thread instead of alarm signals. It avoids the risk of * interrupting syscalls (see #10840) and the risk of being accidentally - * modified in user code using signals. + * modified in user code using signals. NetBSD has also added timerfd + * support since version 10. + * + * For older version of linux/netbsd without timerfd we fall back to the + * pthread based implementation. */ -#if defined(linux_HOST_OS) && HAVE_SYS_TIMERFD_H -#define USE_PTHREAD_FOR_ITIMER +#if HAVE_SYS_TIMERFD_H +#define USE_TIMERFD_FOR_ITIMER #endif -#if defined(freebsd_HOST_OS) +#if defined(linux_HOST_OS) #define USE_PTHREAD_FOR_ITIMER #endif @@ -79,6 +83,10 @@ #define USE_PTHREAD_FOR_ITIMER #endif +#if defined(freebsd_HOST_OS) +#define USE_PTHREAD_FOR_ITIMER +#endif + #if defined(solaris2_HOST_OS) /* USE_TIMER_CREATE is usually disabled for Solaris. In fact it is supported well on this OS, but requires additional privilege. When @@ -98,7 +106,9 @@ ghc-stage2: timer_create: Not owner #endif /* solaris2_HOST_OS */ // Select the variant to use -#if defined(USE_PTHREAD_FOR_ITIMER) +#if defined(USE_TIMERFD_FOR_ITIMER) +#include "ticker/TimerFd.c" +#elif defined(USE_PTHREAD_FOR_ITIMER) #include "ticker/Pthread.c" #elif defined(USE_TIMER_CREATE) #include "ticker/TimerCreate.c" ===================================== rts/posix/ticker/Pthread.c ===================================== @@ -63,13 +63,6 @@ #include #include -#if defined(HAVE_SYS_TIMERFD_H) -#include -#define USE_TIMERFD_FOR_ITIMER 1 -#else -#define USE_TIMERFD_FOR_ITIMER 0 -#endif - /* * TFD_CLOEXEC has been added in Linux 2.6.26. * If it is not available, we use fcntl(F_SETFD). @@ -93,61 +86,16 @@ static Condition start_cond; static Mutex mutex; 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) { - if (poll(pollfds, 2, -1) == -1) { - sysErrorBelch("Ticker: poll failed: %s", strerror(errno)); - } - - // 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) { - sysErrorBelch("Ticker: sleep failed: %s", strerror(errno)); - } + if (rtsSleep(itimer_interval) != 0) { + sysErrorBelch("Ticker: sleep failed: %s", strerror(errno)); } // first try a cheap test @@ -164,10 +112,6 @@ static void *itimer_thread_func(void *_handle_tick) } } - if (USE_TIMERFD_FOR_ITIMER) { - close(timerfd); - } - return NULL; } @@ -186,39 +130,6 @@ initTicker (Time interval, TickProc handle_tick) initCondition(&start_cond); initMutex(&mutex); - /* Open the file descriptor for the timer synchronously. - * - * We used to do it in itimer_thread_func (i.e. in the timer thread) but it - * meant that some user code could run before it and get confused by the - * allocation of the timerfd. - * - * See hClose002 which unsafely closes a file descriptor twice expecting an - * exception the second time: it sometimes failed when the second call to - * "close" closed our own timerfd which inadvertently reused the same file - * descriptor closed by the first call! (see #20618) - */ -#if USE_TIMERFD_FOR_ITIMER - struct itimerspec it; - it.it_value.tv_sec = TimeToSeconds(itimer_interval); - it.it_value.tv_nsec = TimeToNS(itimer_interval) % 1000000000; - it.it_interval = it.it_value; - - timerfd = timerfd_create(CLOCK_MONOTONIC, TFD_CLOEXEC); - if (timerfd == -1) { - barf("timerfd_create: %s", strerror(errno)); - } - if (!TFD_CLOEXEC) { - fcntl(timerfd, F_SETFD, FD_CLOEXEC); - } - if (timerfd_settime(timerfd, 0, &it, NULL)) { - barf("timerfd_settime: %s", strerror(errno)); - } - - if (pipe(pipefds) < 0) { - barf("pipe: %s", strerror(errno)); - } -#endif - /* * Create the thread with all blockable signals blocked, leaving signal * handling to the main and/or other threads. This is especially useful in @@ -269,21 +180,9 @@ 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 { ===================================== rts/posix/ticker/TimerFd.c ===================================== @@ -0,0 +1,280 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1995-2023 + * + * Interval timer for profiling and pre-emptive scheduling. + * + * ---------------------------------------------------------------------------*/ + +/* + * We use a realtime timer by default. I found this much more + * reliable than a CPU timer: + * + * Experiments with different frequencies: using + * CLOCK_REALTIME/CLOCK_MONOTONIC on Linux 2.6.32, + * 1000us has <1% impact on runtime + * 100us has ~2% impact on runtime + * 10us has ~40% impact on runtime + * + * using CLOCK_PROCESS_CPUTIME_ID on Linux 2.6.32, + * I cannot get it to tick faster than 10ms (10000us) + * which isn't great for profiling. + * + * In the threaded RTS, we can't tick in CPU time because the thread + * which has the virtual timer might be idle, so the tick would never + * fire. Therefore we used to tick in realtime in the threaded RTS and + * in CPU time otherwise, but now we always tick in realtime, for + * several reasons: + * + * - resolution (see above) + * - consistency (-threaded is the same as normal) + * - more consistency: Windows only has a realtime timer + * + * Note we want to use CLOCK_MONOTONIC rather than CLOCK_REALTIME, + * because the latter may jump around (NTP adjustments, leap seconds + * etc.). + */ + +#include "rts/PosixSource.h" +#include "Rts.h" + +#include "Ticker.h" +#include "RtsUtils.h" +#include "Proftimer.h" +#include "Schedule.h" +#include "posix/Clock.h" +#include + +#include +#if HAVE_SYS_TIME_H +# include +#endif + +#if defined(HAVE_SIGNAL_H) +# include +#endif + +#include + +#include +#if defined(HAVE_PTHREAD_NP_H) +#include +#endif +#include +#include + +#include + + +/* + * TFD_CLOEXEC has been added in Linux 2.6.26. + * If it is not available, we use fcntl(F_SETFD). + */ +#if !defined(TFD_CLOEXEC) +#define TFD_CLOEXEC 0 +#endif + +static Time itimer_interval = DEFAULT_TICK_INTERVAL; + +// Should we be firing ticks? +// Writers to this must hold the mutex below. +static bool stopped = false; + +// should the ticker thread exit? +// This can be set without holding the mutex. +static bool exited = true; + +// Signaled when we want to (re)start the timer +static Condition start_cond; +static Mutex mutex; +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]; + + pollfds[0].fd = pipefds[0]; + pollfds[0].events = POLLIN; + pollfds[1].fd = timerfd; + pollfds[1].events = POLLIN; + + // 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 (poll(pollfds, 2, -1) == -1) { + sysErrorBelch("Ticker: poll failed: %s", strerror(errno)); + } + + // 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); + } + } + + // first try a cheap test + TSAN_ANNOTATE_BENIGN_RACE(&stopped, "itimer_thread_func"); + if (RELAXED_LOAD(&stopped)) { + OS_ACQUIRE_LOCK(&mutex); + // should we really stop? + if (stopped) { + waitCondition(&start_cond, &mutex); + } + OS_RELEASE_LOCK(&mutex); + } else { + handle_tick(0); + } + } + + close(timerfd); + return NULL; +} + +void +initTicker (Time interval, TickProc handle_tick) +{ + itimer_interval = interval; + stopped = true; + exited = false; +#if defined(HAVE_SIGNAL_H) + sigset_t mask, omask; + int sigret; +#endif + int ret; + + initCondition(&start_cond); + initMutex(&mutex); + + /* Open the file descriptor for the timer synchronously. + * + * We used to do it in itimer_thread_func (i.e. in the timer thread) but it + * meant that some user code could run before it and get confused by the + * allocation of the timerfd. + * + * See hClose002 which unsafely closes a file descriptor twice expecting an + * exception the second time: it sometimes failed when the second call to + * "close" closed our own timerfd which inadvertently reused the same file + * descriptor closed by the first call! (see #20618) + */ + struct itimerspec it; + it.it_value.tv_sec = TimeToSeconds(itimer_interval); + it.it_value.tv_nsec = TimeToNS(itimer_interval) % 1000000000; + it.it_interval = it.it_value; + + timerfd = timerfd_create(CLOCK_MONOTONIC, TFD_CLOEXEC); + if (timerfd == -1) { + barf("timerfd_create: %s", strerror(errno)); + } + if (!TFD_CLOEXEC) { + fcntl(timerfd, F_SETFD, FD_CLOEXEC); + } + if (timerfd_settime(timerfd, 0, &it, NULL)) { + barf("timerfd_settime: %s", strerror(errno)); + } + + if (pipe(pipefds) < 0) { + barf("pipe: %s", strerror(errno)); + } + + /* + * Create the thread with all blockable signals blocked, leaving signal + * handling to the main and/or other threads. This is especially useful in + * the non-threaded runtime, where applications might expect sigprocmask(2) + * to effectively block signals. + */ +#if defined(HAVE_SIGNAL_H) + sigfillset(&mask); + sigret = pthread_sigmask(SIG_SETMASK, &mask, &omask); +#endif + ret = createAttachedOSThread(&thread, "ghc_ticker", itimer_thread_func, (void*)handle_tick); +#if defined(HAVE_SIGNAL_H) + if (sigret == 0) + pthread_sigmask(SIG_SETMASK, &omask, NULL); +#endif + + if (ret != 0) { + barf("Ticker: Failed to spawn thread: %s", strerror(errno)); + } +} + +void +startTicker(void) +{ + OS_ACQUIRE_LOCK(&mutex); + RELAXED_STORE(&stopped, false); + signalCondition(&start_cond); + OS_RELEASE_LOCK(&mutex); +} + +/* There may be at most one additional tick fired after a call to this */ +void +stopTicker(void) +{ + OS_ACQUIRE_LOCK(&mutex); + RELAXED_STORE(&stopped, true); + OS_RELEASE_LOCK(&mutex); +} + +/* There may be at most one additional tick fired after a call to this */ +void +exitTicker (bool wait) +{ + ASSERT(!SEQ_CST_LOAD(&exited)); + SEQ_CST_STORE(&exited, true); + // ensure that ticker wakes up if stopped + startTicker(); + + // wait for ticker to terminate if necessary + if (wait) { + // 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)); + } + + if (pthread_join(thread, NULL)) { + sysErrorBelch("Ticker: Failed to join: %s", strerror(errno)); + } + + // 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]); + + closeMutex(&mutex); + closeCondition(&start_cond); + } else { + pthread_detach(thread); + } +} + +int +rtsTimerSignal(void) +{ + return SIGALRM; +} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/47d0fba86cc11886b9c39f477392fad95bfa7dda...9ad7c49591c73ae7a3c1f989dcd803f9c69d7ad9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/47d0fba86cc11886b9c39f477392fad95bfa7dda...9ad7c49591c73ae7a3c1f989dcd803f9c69d7ad9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 08:03:28 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 03 Feb 2023 03:03:28 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Enable tables next to code for LoongArch64 Message-ID: <63dcbfd0b5e27_1108fe5265c428371@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 283f44d7 by lrzlin at 2023-02-03T03:03:12-05:00 Enable tables next to code for LoongArch64 - - - - - 1c2eb691 by Wander Hillen at 2023-02-03T03:03:15-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 9b628bff by Ben Gamari at 2023-02-03T03:03:16-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 86f5f5d0 by Bodigrim at 2023-02-03T03:03:17-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 853350f5 by Ben Gamari at 2023-02-03T03:03:18-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - 10 changed files: - .gitlab/ci.sh - compiler/GHC/CmmToLlvm/Mangler.hs - compiler/ghc.cabal.in - libraries/base/GHC/IO/Handle/Types.hs - libraries/containers - libraries/ghci/GHCi/InfoTable.hsc - m4/ghc_tables_next_to_code.m4 - rts/posix/Ticker.c - rts/posix/ticker/Pthread.c - + rts/posix/ticker/TimerFd.c Changes: ===================================== .gitlab/ci.sh ===================================== @@ -214,8 +214,6 @@ function set_toolchain_paths() { cat toolchain.sh fi source toolchain.sh - info "--info for GHC for $NIX_SYSTEM" - $GHC --info ;; env) # These are generally set by the Docker image but @@ -274,6 +272,11 @@ function setup() { show_tool CABAL show_tool HAPPY show_tool ALEX + + info "=====================================================" + info "ghc --info" + info "=====================================================" + $GHC --info } function fetch_ghc() { ===================================== compiler/GHC/CmmToLlvm/Mangler.hs ===================================== @@ -38,7 +38,7 @@ llvmFixupAsm platform f1 f2 = {-# SCC "llvm_mangler" #-} -- | These are the rewrites that the mangler will perform rewrites :: [Rewrite] -rewrites = [rewriteSymType, rewriteAVX, rewriteCall] +rewrites = [rewriteSymType, rewriteAVX, rewriteCall, rewriteJump] type Rewrite = Platform -> B.ByteString -> Maybe B.ByteString @@ -123,6 +123,29 @@ rewriteCall platform l removePlt = replaceOnce (B.pack "@plt") (B.pack "") appendInsn i = (`B.append` B.pack ("\n\t" ++ i)) +-- | This rewrites bl and b jump inst to avoid creating PLT entries for +-- functions on loongarch64, because there is no separate call instruction +-- for function calls in loongarch64. Also, this replacement will load +-- the function address from the GOT, which is resolved to point to the +-- real address of the function. +rewriteJump :: Rewrite +rewriteJump platform l + | not isLoongArch64 = Nothing + | isBL l = Just $ replaceJump "bl" "$ra" "$ra" l + | isB l = Just $ replaceJump "b" "$zero" "$t0" l + | otherwise = Nothing + where + isLoongArch64 = platformArch platform == ArchLoongArch64 + isBL = B.isPrefixOf (B.pack "bl\t") + isB = B.isPrefixOf (B.pack "b\t") + + replaceJump jump rd rj l = + appendInsn ("jirl" ++ "\t" ++ rd ++ ", " ++ rj ++ ", 0") $ removeBracket $ + replaceOnce (B.pack (jump ++ "\t%plt(")) (B.pack ("la\t" ++ rj ++ ", ")) l + where + removeBracket = replaceOnce (B.pack ")") (B.pack "") + appendInsn i = (`B.append` B.pack ("\n\t" ++ i)) + -- | @replaceOnce match replace bs@ replaces the first occurrence of the -- substring @match@ in @bs@ with @replace at . replaceOnce :: B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString ===================================== compiler/ghc.cabal.in ===================================== @@ -557,6 +557,7 @@ Library GHC.Platform.ARM GHC.Platform.AArch64 GHC.Platform.Constants + GHC.Platform.LoongArch64 GHC.Platform.NoRegs GHC.Platform.PPC GHC.Platform.Profile @@ -564,7 +565,6 @@ Library GHC.Platform.Reg.Class GHC.Platform.Regs GHC.Platform.RISCV64 - GHC.Platform.LoongArch64 GHC.Platform.S390X GHC.Platform.Wasm32 GHC.Platform.Ways ===================================== libraries/base/GHC/IO/Handle/Types.hs ===================================== @@ -124,11 +124,11 @@ data Handle__ Handle__ { haDevice :: !dev, haType :: HandleType, -- type (read/write/append etc.) - haByteBuffer :: !(IORef (Buffer Word8)), -- See [note Buffering Implementation] + haByteBuffer :: !(IORef (Buffer Word8)), -- See Note [Buffering Implementation] haBufferMode :: BufferMode, haLastDecode :: !(IORef (dec_state, Buffer Word8)), -- ^ The byte buffer just before we did our last batch of decoding. - haCharBuffer :: !(IORef (Buffer CharBufElem)), -- See [note Buffering Implementation] + haCharBuffer :: !(IORef (Buffer CharBufElem)), -- See Note [Buffering Implementation] haBuffers :: !(IORef (BufferList CharBufElem)), -- spare buffers haEncoder :: Maybe (TextEncoder enc_state), haDecoder :: Maybe (TextDecoder dec_state), @@ -261,13 +261,13 @@ data BufferMode ) {- -[note Buffering Implementation] - +Note [Buffering Implementation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Each Handle has two buffers: a byte buffer (haByteBuffer) and a Char buffer (haCharBuffer). -[note Buffered Reading] - +Note [Buffered Reading] +~~~~~~~~~~~~~~~~~~~~~~~ For read Handles, bytes are read into the byte buffer, and immediately decoded into the Char buffer (see GHC.IO.Handle.Internals.readTextDevice). The only way there might be @@ -279,8 +279,8 @@ reading data into a Handle. When reading, we can always just read all the data there is available without blocking, decode it into the Char buffer, and then provide it immediately to the caller. -[note Buffered Writing] - +Note [Buffered Writing] +~~~~~~~~~~~~~~~~~~~~~~~ Characters are written into the Char buffer by e.g. hPutStr. At the end of the operation, or when the char buffer is full, the buffer is decoded to the byte buffer (see writeCharBuffer). This is so that we @@ -288,8 +288,8 @@ can detect encoding errors at the right point. Hence, the Char buffer is always empty between Handle operations. -[note Buffer Sizing] - +Note [Buffer Sizing] +~~~~~~~~~~~~~~~~~~~~ The char buffer is always a default size (dEFAULT_CHAR_BUFFER_SIZE). The byte buffer size is chosen by the underlying device (via its IODevice.newBuffer). Hence the size of these buffers is not under @@ -322,8 +322,8 @@ writeCharBuffer, which checks whether the buffer should be flushed according to the current buffering mode. Additionally, we look for newlines and flush if the mode is LineBuffering. -[note Buffer Flushing] - +Note [Buffer Flushing] +~~~~~~~~~~~~~~~~~~~~~~ ** Flushing the Char buffer We must be able to flush the Char buffer, in order to implement ===================================== libraries/containers ===================================== @@ -1 +1 @@ -Subproject commit fbafcf704f0febd9ddac84dbe00ae3787af43550 +Subproject commit 9f4a93604c66a5e605ce46fc30003b71802b3cfd ===================================== libraries/ghci/GHCi/InfoTable.hsc ===================================== @@ -228,6 +228,15 @@ mkJumpToAddr a = case hostPlatformArch of , fromIntegral w64 , fromIntegral (w64 `shiftR` 32) ] + ArchLoongArch64 -> pure $ + let w64 = fromIntegral (funPtrToInt a) :: Word64 + in Right [ 0x1c00000c -- pcaddu12i $t0,0 + , 0x28c0418c -- ld.d $t0,$t0,16 + , 0x4c000180 -- jr $t0 + , 0x03400000 -- nop + , fromIntegral w64 + , fromIntegral (w64 `shiftR` 32) ] + arch -> -- The arch isn't supported. You either need to add your architecture as a -- distinct case, or use non-TABLES_NEXT_TO_CODE mode. ===================================== m4/ghc_tables_next_to_code.m4 ===================================== @@ -17,7 +17,7 @@ AC_DEFUN([GHC_TABLES_NEXT_TO_CODE], case "$Unregisterised" in NO) case "$TargetArch" in - ia64|powerpc64|powerpc64le|s390x|wasm32|loongarch64) + ia64|powerpc64|powerpc64le|s390x|wasm32) TablesNextToCodeDefault=NO AC_MSG_RESULT([no]) ;; ===================================== rts/posix/Ticker.c ===================================== @@ -65,13 +65,17 @@ * On Linux we can use timerfd_* (introduced in Linux * 2.6.25) and a thread instead of alarm signals. It avoids the risk of * interrupting syscalls (see #10840) and the risk of being accidentally - * modified in user code using signals. + * modified in user code using signals. NetBSD has also added timerfd + * support since version 10. + * + * For older version of linux/netbsd without timerfd we fall back to the + * pthread based implementation. */ -#if defined(linux_HOST_OS) && HAVE_SYS_TIMERFD_H -#define USE_PTHREAD_FOR_ITIMER +#if HAVE_SYS_TIMERFD_H +#define USE_TIMERFD_FOR_ITIMER #endif -#if defined(freebsd_HOST_OS) +#if defined(linux_HOST_OS) #define USE_PTHREAD_FOR_ITIMER #endif @@ -79,6 +83,10 @@ #define USE_PTHREAD_FOR_ITIMER #endif +#if defined(freebsd_HOST_OS) +#define USE_PTHREAD_FOR_ITIMER +#endif + #if defined(solaris2_HOST_OS) /* USE_TIMER_CREATE is usually disabled for Solaris. In fact it is supported well on this OS, but requires additional privilege. When @@ -98,7 +106,9 @@ ghc-stage2: timer_create: Not owner #endif /* solaris2_HOST_OS */ // Select the variant to use -#if defined(USE_PTHREAD_FOR_ITIMER) +#if defined(USE_TIMERFD_FOR_ITIMER) +#include "ticker/TimerFd.c" +#elif defined(USE_PTHREAD_FOR_ITIMER) #include "ticker/Pthread.c" #elif defined(USE_TIMER_CREATE) #include "ticker/TimerCreate.c" ===================================== rts/posix/ticker/Pthread.c ===================================== @@ -63,13 +63,6 @@ #include #include -#if defined(HAVE_SYS_TIMERFD_H) -#include -#define USE_TIMERFD_FOR_ITIMER 1 -#else -#define USE_TIMERFD_FOR_ITIMER 0 -#endif - /* * TFD_CLOEXEC has been added in Linux 2.6.26. * If it is not available, we use fcntl(F_SETFD). @@ -93,61 +86,16 @@ static Condition start_cond; static Mutex mutex; 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) { - if (poll(pollfds, 2, -1) == -1) { - sysErrorBelch("Ticker: poll failed: %s", strerror(errno)); - } - - // 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) { - sysErrorBelch("Ticker: sleep failed: %s", strerror(errno)); - } + if (rtsSleep(itimer_interval) != 0) { + sysErrorBelch("Ticker: sleep failed: %s", strerror(errno)); } // first try a cheap test @@ -164,10 +112,6 @@ static void *itimer_thread_func(void *_handle_tick) } } - if (USE_TIMERFD_FOR_ITIMER) { - close(timerfd); - } - return NULL; } @@ -186,39 +130,6 @@ initTicker (Time interval, TickProc handle_tick) initCondition(&start_cond); initMutex(&mutex); - /* Open the file descriptor for the timer synchronously. - * - * We used to do it in itimer_thread_func (i.e. in the timer thread) but it - * meant that some user code could run before it and get confused by the - * allocation of the timerfd. - * - * See hClose002 which unsafely closes a file descriptor twice expecting an - * exception the second time: it sometimes failed when the second call to - * "close" closed our own timerfd which inadvertently reused the same file - * descriptor closed by the first call! (see #20618) - */ -#if USE_TIMERFD_FOR_ITIMER - struct itimerspec it; - it.it_value.tv_sec = TimeToSeconds(itimer_interval); - it.it_value.tv_nsec = TimeToNS(itimer_interval) % 1000000000; - it.it_interval = it.it_value; - - timerfd = timerfd_create(CLOCK_MONOTONIC, TFD_CLOEXEC); - if (timerfd == -1) { - barf("timerfd_create: %s", strerror(errno)); - } - if (!TFD_CLOEXEC) { - fcntl(timerfd, F_SETFD, FD_CLOEXEC); - } - if (timerfd_settime(timerfd, 0, &it, NULL)) { - barf("timerfd_settime: %s", strerror(errno)); - } - - if (pipe(pipefds) < 0) { - barf("pipe: %s", strerror(errno)); - } -#endif - /* * Create the thread with all blockable signals blocked, leaving signal * handling to the main and/or other threads. This is especially useful in @@ -269,21 +180,9 @@ 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 { ===================================== rts/posix/ticker/TimerFd.c ===================================== @@ -0,0 +1,280 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1995-2023 + * + * Interval timer for profiling and pre-emptive scheduling. + * + * ---------------------------------------------------------------------------*/ + +/* + * We use a realtime timer by default. I found this much more + * reliable than a CPU timer: + * + * Experiments with different frequencies: using + * CLOCK_REALTIME/CLOCK_MONOTONIC on Linux 2.6.32, + * 1000us has <1% impact on runtime + * 100us has ~2% impact on runtime + * 10us has ~40% impact on runtime + * + * using CLOCK_PROCESS_CPUTIME_ID on Linux 2.6.32, + * I cannot get it to tick faster than 10ms (10000us) + * which isn't great for profiling. + * + * In the threaded RTS, we can't tick in CPU time because the thread + * which has the virtual timer might be idle, so the tick would never + * fire. Therefore we used to tick in realtime in the threaded RTS and + * in CPU time otherwise, but now we always tick in realtime, for + * several reasons: + * + * - resolution (see above) + * - consistency (-threaded is the same as normal) + * - more consistency: Windows only has a realtime timer + * + * Note we want to use CLOCK_MONOTONIC rather than CLOCK_REALTIME, + * because the latter may jump around (NTP adjustments, leap seconds + * etc.). + */ + +#include "rts/PosixSource.h" +#include "Rts.h" + +#include "Ticker.h" +#include "RtsUtils.h" +#include "Proftimer.h" +#include "Schedule.h" +#include "posix/Clock.h" +#include + +#include +#if HAVE_SYS_TIME_H +# include +#endif + +#if defined(HAVE_SIGNAL_H) +# include +#endif + +#include + +#include +#if defined(HAVE_PTHREAD_NP_H) +#include +#endif +#include +#include + +#include + + +/* + * TFD_CLOEXEC has been added in Linux 2.6.26. + * If it is not available, we use fcntl(F_SETFD). + */ +#if !defined(TFD_CLOEXEC) +#define TFD_CLOEXEC 0 +#endif + +static Time itimer_interval = DEFAULT_TICK_INTERVAL; + +// Should we be firing ticks? +// Writers to this must hold the mutex below. +static bool stopped = false; + +// should the ticker thread exit? +// This can be set without holding the mutex. +static bool exited = true; + +// Signaled when we want to (re)start the timer +static Condition start_cond; +static Mutex mutex; +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]; + + pollfds[0].fd = pipefds[0]; + pollfds[0].events = POLLIN; + pollfds[1].fd = timerfd; + pollfds[1].events = POLLIN; + + // 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 (poll(pollfds, 2, -1) == -1) { + sysErrorBelch("Ticker: poll failed: %s", strerror(errno)); + } + + // 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); + } + } + + // first try a cheap test + TSAN_ANNOTATE_BENIGN_RACE(&stopped, "itimer_thread_func"); + if (RELAXED_LOAD(&stopped)) { + OS_ACQUIRE_LOCK(&mutex); + // should we really stop? + if (stopped) { + waitCondition(&start_cond, &mutex); + } + OS_RELEASE_LOCK(&mutex); + } else { + handle_tick(0); + } + } + + close(timerfd); + return NULL; +} + +void +initTicker (Time interval, TickProc handle_tick) +{ + itimer_interval = interval; + stopped = true; + exited = false; +#if defined(HAVE_SIGNAL_H) + sigset_t mask, omask; + int sigret; +#endif + int ret; + + initCondition(&start_cond); + initMutex(&mutex); + + /* Open the file descriptor for the timer synchronously. + * + * We used to do it in itimer_thread_func (i.e. in the timer thread) but it + * meant that some user code could run before it and get confused by the + * allocation of the timerfd. + * + * See hClose002 which unsafely closes a file descriptor twice expecting an + * exception the second time: it sometimes failed when the second call to + * "close" closed our own timerfd which inadvertently reused the same file + * descriptor closed by the first call! (see #20618) + */ + struct itimerspec it; + it.it_value.tv_sec = TimeToSeconds(itimer_interval); + it.it_value.tv_nsec = TimeToNS(itimer_interval) % 1000000000; + it.it_interval = it.it_value; + + timerfd = timerfd_create(CLOCK_MONOTONIC, TFD_CLOEXEC); + if (timerfd == -1) { + barf("timerfd_create: %s", strerror(errno)); + } + if (!TFD_CLOEXEC) { + fcntl(timerfd, F_SETFD, FD_CLOEXEC); + } + if (timerfd_settime(timerfd, 0, &it, NULL)) { + barf("timerfd_settime: %s", strerror(errno)); + } + + if (pipe(pipefds) < 0) { + barf("pipe: %s", strerror(errno)); + } + + /* + * Create the thread with all blockable signals blocked, leaving signal + * handling to the main and/or other threads. This is especially useful in + * the non-threaded runtime, where applications might expect sigprocmask(2) + * to effectively block signals. + */ +#if defined(HAVE_SIGNAL_H) + sigfillset(&mask); + sigret = pthread_sigmask(SIG_SETMASK, &mask, &omask); +#endif + ret = createAttachedOSThread(&thread, "ghc_ticker", itimer_thread_func, (void*)handle_tick); +#if defined(HAVE_SIGNAL_H) + if (sigret == 0) + pthread_sigmask(SIG_SETMASK, &omask, NULL); +#endif + + if (ret != 0) { + barf("Ticker: Failed to spawn thread: %s", strerror(errno)); + } +} + +void +startTicker(void) +{ + OS_ACQUIRE_LOCK(&mutex); + RELAXED_STORE(&stopped, false); + signalCondition(&start_cond); + OS_RELEASE_LOCK(&mutex); +} + +/* There may be at most one additional tick fired after a call to this */ +void +stopTicker(void) +{ + OS_ACQUIRE_LOCK(&mutex); + RELAXED_STORE(&stopped, true); + OS_RELEASE_LOCK(&mutex); +} + +/* There may be at most one additional tick fired after a call to this */ +void +exitTicker (bool wait) +{ + ASSERT(!SEQ_CST_LOAD(&exited)); + SEQ_CST_STORE(&exited, true); + // ensure that ticker wakes up if stopped + startTicker(); + + // wait for ticker to terminate if necessary + if (wait) { + // 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)); + } + + if (pthread_join(thread, NULL)) { + sysErrorBelch("Ticker: Failed to join: %s", strerror(errno)); + } + + // 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]); + + closeMutex(&mutex); + closeCondition(&start_cond); + } else { + pthread_detach(thread); + } +} + +int +rtsTimerSignal(void) +{ + return SIGALRM; +} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9ad7c49591c73ae7a3c1f989dcd803f9c69d7ad9...853350f58677a57e367d16a16cb0031986b5d7ec -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9ad7c49591c73ae7a3c1f989dcd803f9c69d7ad9...853350f58677a57e367d16a16cb0031986b5d7ec You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 08:43:43 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Fri, 03 Feb 2023 03:43:43 -0500 Subject: [Git][ghc/ghc][wip/T22740] 2 commits: fix config.sub Message-ID: <63dcc93f2d553_1108fe5260c4385a5@gitlab.mail> Sylvain Henry pushed to branch wip/T22740 at Glasgow Haskell Compiler / GHC Commits: 619a874e by Sylvain Henry at 2023-02-03T09:45:04+01:00 fix config.sub - - - - - 55f7a976 by Sylvain Henry at 2023-02-03T09:48:08+01:00 Fix configure - - - - - 4 changed files: - config.sub - configure.ac - m4/fptools_set_haskell_platform_vars.m4 - m4/ghc_convert_cpu.m4 Changes: ===================================== config.sub ===================================== @@ -1190,7 +1190,7 @@ case $cpu-$vendor in | arc | arceb | arc32 | arc64 \ | arm | arm[lb]e | arme[lb] | armv* \ | avr | avr32 \ - | asmjs | js \ + | asmjs | javascript \ | ba \ | be32 | be64 \ | bfin | bpf | bs2000 \ ===================================== configure.ac ===================================== @@ -333,7 +333,7 @@ AC_SUBST(TablesNextToCode) dnl ** Does target have runtime linker support? dnl -------------------------------------------------------------- case "$target" in - powerpc64-*|powerpc64le-*|powerpc-ibm-aix*|s390x-ibm-linux|riscv64-*|wasm*|js-*|loongarch64-*) + powerpc64-*|powerpc64le-*|powerpc-ibm-aix*|s390x-ibm-linux|riscv64-*|wasm*|javascript-*|loongarch64-*) TargetHasRTSLinker=NO ;; *) ===================================== m4/fptools_set_haskell_platform_vars.m4 ===================================== @@ -51,7 +51,7 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS_SHELL_FUNCTIONS], hppa|hppa1_1|ia64|m68k|nios2|riscv32|loongarch32|rs6000|s390|sh4|vax) test -z "[$]2" || eval "[$]2=ArchUnknown" ;; - js) + javascript) test -z "[$]2" || eval "[$]2=ArchJavaScript" ;; *) ===================================== m4/ghc_convert_cpu.m4 ===================================== @@ -83,8 +83,8 @@ case "$1" in wasm32) $2="wasm32" ;; - js) - $2="js" + javascript) + $2="javascript" ;; *) echo "Unknown CPU $1" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c2775e1939a4355054bfaa4d79539026b0527605...55f7a976e5084cf0e7fc98dcf479a01982c2a2de -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c2775e1939a4355054bfaa4d79539026b0527605...55f7a976e5084cf0e7fc98dcf479a01982c2a2de You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 08:50:40 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Fri, 03 Feb 2023 03:50:40 -0500 Subject: [Git][ghc/ghc][wip/T22740] More Message-ID: <63dccae0fb17_1108fe5268444083b@gitlab.mail> Sylvain Henry pushed to branch wip/T22740 at Glasgow Haskell Compiler / GHC Commits: e2d84768 by Sylvain Henry at 2023-02-03T09:55:07+01:00 More - - - - - 3 changed files: - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - libraries/ghc-boot/GHC/Platform/ArchOS.hs Changes: ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -102,14 +102,14 @@ platformSupportsSharedLibs = do wasm <- anyTargetArch [ "wasm32" ] ppc_linux <- anyTargetPlatform [ "powerpc-unknown-linux" ] solaris <- anyTargetPlatform [ "i386-unknown-solaris2" ] - javascript <- anyTargetArch [ "js" ] + javascript <- anyTargetArch [ "javascript" ] solarisBroken <- flag SolarisBrokenShld return $ not (windows || wasm || javascript || ppc_linux || solaris && solarisBroken) -- | Does the target support threaded RTS? targetSupportsThreadedRts :: Action Bool targetSupportsThreadedRts = do - bad_arch <- anyTargetArch [ "wasm32", "js" ] + bad_arch <- anyTargetArch [ "wasm32", "javascript" ] return $ not bad_arch -- | Does the target support the -N RTS flag? ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -258,7 +258,7 @@ isWinTarget :: Action Bool isWinTarget = anyTargetOs ["mingw32"] isJsTarget :: Action Bool -isJsTarget = anyTargetArch ["js"] +isJsTarget = anyTargetArch ["javascript"] isOsxTarget :: Action Bool isOsxTarget = anyTargetOs ["darwin"] ===================================== libraries/ghc-boot/GHC/Platform/ArchOS.hs ===================================== @@ -136,7 +136,7 @@ stringEncodeArch = \case ArchMipsel -> "mipsel" ArchRISCV64 -> "riscv64" ArchLoongArch64 -> "loongarch64" - ArchJavaScript -> "js" + ArchJavaScript -> "javascript" ArchWasm32 -> "wasm32" -- | See Note [Platform Syntax]. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e2d8476842d20e9a80aafb46e54d3ae8a3cc097d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e2d8476842d20e9a80aafb46e54d3ae8a3cc097d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 09:20:17 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Fri, 03 Feb 2023 04:20:17 -0500 Subject: [Git][ghc/ghc][wip/js-th] 34 commits: Fixes for cabal-reinstall CI job Message-ID: <63dcd1d1e3b61_1108fe526204514e1@gitlab.mail> Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC Commits: 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 9e0047d3 by Sylvain Henry at 2023-02-03T10:21:48+01:00 Merge libiserv with ghci - - - - - e88d2cf6 by Sylvain Henry at 2023-02-03T10:21:52+01:00 Wire ghci unit - - - - - af546765 by Sylvain Henry at 2023-02-03T10:23:11+01:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - CODEOWNERS - cabal.project-reinstall - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Reg.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bdadddd4f7e72b6aa2fe319528ad7954d898b620...af5467650ad0d0510e09a765df3743b798bcbee6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bdadddd4f7e72b6aa2fe319528ad7954d898b620...af5467650ad0d0510e09a765df3743b798bcbee6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 09:23:02 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Fri, 03 Feb 2023 04:23:02 -0500 Subject: [Git][ghc/ghc][wip/js-th] 3 commits: Merge libiserv with ghci Message-ID: <63dcd276e40cb_1108fe5264845218@gitlab.mail> Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC Commits: 3c3493e4 by Sylvain Henry at 2023-02-03T10:27:27+01:00 Merge libiserv with ghci - - - - - 532eb745 by Sylvain Henry at 2023-02-03T10:27:27+01:00 Wire ghci unit - - - - - f199e7f4 by Sylvain Henry at 2023-02-03T10:27:27+01:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 30 changed files: - CODEOWNERS - cabal.project-reinstall - compiler/GHC.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Runtime/Interpreter.hs - + compiler/GHC/Runtime/Interpreter/JS.hs - + compiler/GHC/Runtime/Interpreter/Process.hs - compiler/GHC/Runtime/Interpreter/Types.hs - + compiler/GHC/Runtime/Utils.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Deps.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Linker/Types.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Types.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Unit/Types.hs - compiler/ghc.cabal.in - docs/users_guide/9.6.1-notes.rst - docs/users_guide/9.8.1-notes.rst - + ghc-interp.js - hadrian/src/Base.hs - hadrian/src/Packages.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - libraries/base/System/Posix/Internals.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/af5467650ad0d0510e09a765df3743b798bcbee6...f199e7f4a557e914d9ace51b82036a89d72f07d6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/af5467650ad0d0510e09a765df3743b798bcbee6...f199e7f4a557e914d9ace51b82036a89d72f07d6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 09:39:45 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Fri, 03 Feb 2023 04:39:45 -0500 Subject: [Git][ghc/ghc][wip/9.2.6-backports] Testsuite fixes Message-ID: <63dcd661d6c99_1108fec035f045544b@gitlab.mail> Zubin pushed to branch wip/9.2.6-backports at Glasgow Haskell Compiler / GHC Commits: 34dd0823 by Zubin Duggal at 2023-02-03T15:08:48+05:30 Testsuite fixes - - - - - 6 changed files: - testsuite/tests/ghci/scripts/T9881.stdout - testsuite/tests/ghci/scripts/ghci025.stdout - testsuite/tests/safeHaskell/warnings/T22728.stderr - testsuite/tests/safeHaskell/warnings/T22728b.stderr - testsuite/tests/typecheck/should_fail/T22645.stderr - testsuite/tests/warnings/should_compile/T16282/T16282.stderr Changes: ===================================== testsuite/tests/ghci/scripts/T9881.stdout ===================================== @@ -19,19 +19,19 @@ instance Read Data.ByteString.Lazy.ByteString type Data.ByteString.ByteString :: * data Data.ByteString.ByteString - = Data.ByteString.Internal.BS {-# UNPACK #-}(GHC.ForeignPtr.ForeignPtr - GHC.Word.Word8) - {-# UNPACK #-}Int - -- Defined in ‘Data.ByteString.Internal’ + = bytestring-0.11.4.0:Data.ByteString.Internal.Type.BS {-# UNPACK #-}(GHC.ForeignPtr.ForeignPtr + GHC.Word.Word8) + {-# UNPACK #-}Int + -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ instance Eq Data.ByteString.ByteString - -- Defined in ‘Data.ByteString.Internal’ + -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ instance Monoid Data.ByteString.ByteString - -- Defined in ‘Data.ByteString.Internal’ + -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ instance Ord Data.ByteString.ByteString - -- Defined in ‘Data.ByteString.Internal’ + -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ instance Semigroup Data.ByteString.ByteString - -- Defined in ‘Data.ByteString.Internal’ + -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ instance Show Data.ByteString.ByteString - -- Defined in ‘Data.ByteString.Internal’ + -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ instance Read Data.ByteString.ByteString - -- Defined in ‘Data.ByteString.Internal’ + -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ ===================================== testsuite/tests/ghci/scripts/ghci025.stdout ===================================== @@ -53,7 +53,9 @@ Prelude.length :: Data.Foldable.Foldable t => t a -> GHC.Types.Int -- imported via T type T.Integer :: * data T.Integer = ... -T.length :: Data.ByteString.Internal.ByteString -> GHC.Types.Int +T.length :: + bytestring-0.11.4.0:Data.ByteString.Internal.Type.ByteString + -> GHC.Types.Int :browse! T -- defined locally T.length :: T.Integer ===================================== testsuite/tests/safeHaskell/warnings/T22728.stderr ===================================== @@ -1,4 +1,4 @@ [2 of 2] Compiling T22728 ( T22728.hs, T22728.o ) -T22728.hs:6:1: warning: [GHC-82658] [-Winferred-safe-imports] +T22728.hs:6:1: warning: [-Winferred-safe-imports] Importing Safe-Inferred module T22728_B from explicitly Safe module ===================================== testsuite/tests/safeHaskell/warnings/T22728b.stderr ===================================== @@ -1,4 +1,4 @@ [2 of 2] Compiling T22728b ( T22728b.hs, T22728b.o ) -T22728b.hs:6:1: error: [GHC-82658] [-Winferred-safe-imports, Werror=inferred-safe-imports] +T22728b.hs:6:1: error: [-Winferred-safe-imports, -Werror=inferred-safe-imports] Importing Safe-Inferred module T22728b_B from explicitly Safe module ===================================== testsuite/tests/typecheck/should_fail/T22645.stderr ===================================== @@ -1,5 +1,5 @@ -T22645.hs:9:5: error: [GHC-25897] +T22645.hs:9:5: error: • Couldn't match type ‘a’ with ‘b’ arising from a use of ‘coerce’ ‘a’ is a rigid type variable bound by the type signature for: ===================================== testsuite/tests/warnings/should_compile/T16282/T16282.stderr ===================================== @@ -5,5 +5,6 @@ T16282.hs: warning: [-Wall-missed-specialisations] Probable fix: add INLINABLE pragma on ‘Data.Foldable.$wmapM_’ T16282.hs: warning: [-Wall-missed-specialisations] - Could not specialise imported function ‘Data.Map.Internal.$fShowMap_$cshowsPrec’ - Probable fix: add INLINABLE pragma on ‘Data.Map.Internal.$fShowMap_$cshowsPrec’ + Could not specialise imported function ‘Data.Map.Internal.$w$cshowsPrec’ + when specialising ‘Data.Map.Internal.$fShowMap_$cshowsPrec’ + Probable fix: add INLINABLE pragma on ‘Data.Map.Internal.$w$cshowsPrec’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/34dd0823f59b2e9d32b79d84c843b9bc8f158c56 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/34dd0823f59b2e9d32b79d84c843b9bc8f158c56 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 09:45:23 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Fri, 03 Feb 2023 04:45:23 -0500 Subject: [Git][ghc/ghc][wip/andreask/infer-bytecode] Fix some correctness issues around tag inference when targeting the bytecode generator. Message-ID: <63dcd7b3d9bcf_1108fec035f046114c@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/infer-bytecode at Glasgow Haskell Compiler / GHC Commits: b959ad0b by Andreas Klebinger at 2023-02-03T10:44:42+01:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9 changed files: - compiler/GHC/Driver/Config/Stg/Pipeline.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Types.hs - compiler/GHC/Stg/Pipeline.hs - + testsuite/tests/simplStg/should_compile/T22840.hs - + testsuite/tests/simplStg/should_compile/T22840.stderr - + testsuite/tests/simplStg/should_compile/T22840A.hs - + testsuite/tests/simplStg/should_compile/T22840B.hs - testsuite/tests/simplStg/should_compile/all.T Changes: ===================================== compiler/GHC/Driver/Config/Stg/Pipeline.hs ===================================== @@ -22,6 +22,7 @@ initStgPipelineOpts dflags for_bytecode = StgPipelineOpts , stgPipeline_pprOpts = initStgPprOpts dflags , stgPipeline_phases = getStgToDo for_bytecode dflags , stgPlatform = targetPlatform dflags + , stgPipeline_forBytecode = for_bytecode } -- | Which Stg-to-Stg passes to run. Depends on flags, ways etc. ===================================== compiler/GHC/Stg/InferTags.hs ===================================== @@ -204,6 +204,33 @@ a different StgPass! To handle this a large part of the analysis is polymorphic over the exact StgPass we are using. Which allows us to run the analysis on the output of itself. +Note [Tag inference for interpreted code] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The bytecode interpreter has a different behaviour when it comes +to the tagging of binders in certain situations than the StgToCmm code generator. + +a) Tags for let-bindings: + + When compiling a binding for a constructor like `let x = Just True` + Weither or not `x` results in x pointing depends on the backend. + For the interpreter x points to a BCO which once + evaluated returns a properly tagged pointer to the heap object. + In the Cmm backend for the same binding we would allocate the constructor right + away and x will immediately be represented by a tagged pointer. + This means for interpreted code we can not assume let bound constructors are + properly tagged. Hence we distinguish between targeting bytecode and native in + the analysis. + We make this differentiation in `mkLetSig` where we simply never assume + lets are tagged when targeting bytecode. + +b) When referencing ids from other modules the Cmm backend will try to put a + proper tag on these references through various means. When doing analysis we + usually predict these cases to improve precision of the analysis. + But to my knowledge the bytecode generator makes no such attempts so we must + not infer imported bindings as tagged. + This is handled in GHC.Stg.InferTags.Types.lookupInfo + + -} {- ********************************************************************* @@ -212,20 +239,12 @@ the output of itself. * * ********************************************************************* -} --- doCodeGen :: HscEnv -> Module -> InfoTableProvMap -> [TyCon] --- -> CollectedCCs --- -> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs --- -> HpcInfo --- -> IO (Stream IO CmmGroupSRTs CmmCgInfos) --- -- Note we produce a 'Stream' of CmmGroups, so that the --- -- backend can be run incrementally. Otherwise it generates all --- -- the C-- up front, which has a significant space cost. -inferTags :: StgPprOpts -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) -inferTags ppr_opts logger this_mod stg_binds = do - +inferTags :: StgPprOpts -> Bool -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) +inferTags ppr_opts !for_bytecode logger this_mod stg_binds = do + -- pprTraceM "inferTags for " (ppr this_mod <> text " bytecode:" <> ppr for_bytecode) -- Annotate binders with tag information. let (!stg_binds_w_tags) = {-# SCC "StgTagFields" #-} - inferTagsAnal stg_binds + inferTagsAnal for_bytecode stg_binds putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings ppr_opts stg_binds_w_tags) let export_tag_info = collectExportInfo stg_binds_w_tags @@ -254,10 +273,10 @@ type InferExtEq i = ( XLet i ~ XLet 'InferTaggedBinders , XLetNoEscape i ~ XLetNoEscape 'InferTaggedBinders , XRhsClosure i ~ XRhsClosure 'InferTaggedBinders) -inferTagsAnal :: [GenStgTopBinding 'CodeGen] -> [GenStgTopBinding 'InferTaggedBinders] -inferTagsAnal binds = +inferTagsAnal :: Bool -> [GenStgTopBinding 'CodeGen] -> [GenStgTopBinding 'InferTaggedBinders] +inferTagsAnal for_bytecode binds = -- pprTrace "Binds" (pprGenStgTopBindings shortStgPprOpts $ binds) $ - snd (mapAccumL inferTagTopBind initEnv binds) + snd (mapAccumL inferTagTopBind (initEnv for_bytecode) binds) ----------------------- inferTagTopBind :: TagEnv 'CodeGen -> GenStgTopBinding 'CodeGen @@ -420,11 +439,12 @@ inferTagBind in_env (StgNonRec bndr rhs) -- ppr bndr $$ -- ppr (isDeadEndId id) $$ -- ppr sig) - (env', StgNonRec (id, sig) rhs') + (env', StgNonRec (id, out_sig) rhs') where id = getBinderId in_env bndr - env' = extendSigEnv in_env [(id, sig)] - (sig,rhs') = inferTagRhs id in_env rhs + (in_sig,rhs') = inferTagRhs id in_env rhs + out_sig = mkLetSig in_env in_sig + env' = extendSigEnv in_env [(id, out_sig)] inferTagBind in_env (StgRec pairs) = -- pprTrace "rec" (ppr (map fst pairs) $$ ppr (in_env { te_env = out_env }, StgRec pairs')) $ @@ -443,14 +463,17 @@ inferTagBind in_env (StgRec pairs) | in_sigs == out_sigs = (te_env rhs_env, out_bndrs `zip` rhss') | otherwise = go env' out_sigs rhss' where - out_bndrs = map updateBndr in_bndrs -- TODO: Keeps in_ids alive in_bndrs = in_ids `zip` in_sigs + out_bndrs = map updateBndr in_bndrs -- TODO: Keeps in_ids alive rhs_env = extendSigEnv go_env in_bndrs (out_sigs, rhss') = unzip (zipWithEqual "inferTagBind" anaRhs in_ids go_rhss) env' = makeTagged go_env anaRhs :: Id -> GenStgRhs q -> (TagSig, GenStgRhs 'InferTaggedBinders) - anaRhs bnd rhs = inferTagRhs bnd rhs_env rhs + anaRhs bnd rhs = + let (sig_rhs,rhs') = inferTagRhs bnd rhs_env rhs + in (mkLetSig go_env sig_rhs, rhs') + updateBndr :: (Id,TagSig) -> (Id,TagSig) updateBndr (v,sig) = (setIdTagSig v sig, sig) @@ -536,6 +559,15 @@ inferTagRhs _ env _rhs@(StgRhsCon cc con cn ticks args) = --pprTrace "inferTagRhsCon" (ppr grp_ids) $ (TagSig (inferConTag env con args), StgRhsCon cc con cn ticks args) +-- Adjust let semantics to the targeted backend. +-- See Note [Tag inference for interpreted code] +mkLetSig :: TagEnv p -> TagSig -> TagSig +mkLetSig env in_sig + | for_bytecode = TagSig TagDunno + | otherwise = in_sig + where + for_bytecode = te_bytecode env + {- Note [Constructor TagSigs] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @inferConTag@ will infer the proper tag signature for a binding who's RHS is a constructor ===================================== compiler/GHC/Stg/InferTags/Types.hs ===================================== @@ -49,24 +49,30 @@ combineAltInfo ti TagTagged = ti type TagSigEnv = IdEnv TagSig data TagEnv p = TE { te_env :: TagSigEnv , te_get :: BinderP p -> Id + , te_bytecode :: !Bool } instance Outputable (TagEnv p) where - ppr te = ppr (te_env te) - + ppr te = for_txt <+> ppr (te_env te) + where + for_txt = if te_bytecode te + then text "for_bytecode" + else text "for_native" getBinderId :: TagEnv p -> BinderP p -> Id getBinderId = te_get -initEnv :: TagEnv 'CodeGen -initEnv = TE { te_env = emptyVarEnv - , te_get = \x -> x} +initEnv :: Bool -> TagEnv 'CodeGen +initEnv for_bytecode = TE { te_env = emptyVarEnv + , te_get = \x -> x + , te_bytecode = for_bytecode } -- | Simple convert env to a env of the 'InferTaggedBinders pass -- with no other changes. makeTagged :: TagEnv p -> TagEnv 'InferTaggedBinders makeTagged env = TE { te_env = te_env env - , te_get = fst } + , te_get = fst + , te_bytecode = te_bytecode env } noSig :: TagEnv p -> BinderP p -> (Id, TagSig) noSig env bndr @@ -75,14 +81,18 @@ noSig env bndr where var = getBinderId env bndr +-- | Look up a sig in the given env lookupSig :: TagEnv p -> Id -> Maybe TagSig lookupSig env fun = lookupVarEnv (te_env env) fun +-- | Look up a sig in the env or derive it from information +-- in the arg itself. lookupInfo :: TagEnv p -> StgArg -> TagInfo lookupInfo env (StgVarArg var) -- Nullary data constructors like True, False | Just dc <- isDataConWorkId_maybe var , isNullaryRepDataCon dc + , not for_bytecode = TagProper | isUnliftedType (idType var) @@ -93,6 +103,7 @@ lookupInfo env (StgVarArg var) = info | Just lf_info <- idLFInfo_maybe var + , not for_bytecode = case lf_info of -- Function, tagged (with arity) LFReEntrant {} @@ -112,6 +123,8 @@ lookupInfo env (StgVarArg var) | otherwise = TagDunno + where + for_bytecode = te_bytecode env lookupInfo _ (StgLitArg {}) = TagProper ===================================== compiler/GHC/Stg/Pipeline.hs ===================================== @@ -50,6 +50,7 @@ data StgPipelineOpts = StgPipelineOpts -- ^ Should we lint the STG at various stages of the pipeline? , stgPipeline_pprOpts :: !StgPprOpts , stgPlatform :: !Platform + , stgPipeline_forBytecode :: !Bool } newtype StgM a = StgM { _unStgM :: ReaderT Char IO a } @@ -89,7 +90,7 @@ stg2stg logger extra_vars opts this_mod binds -- annotations (which is used by code generator to compute offsets into closures) ; let binds_sorted_with_fvs = depSortWithAnnotStgPgm this_mod binds' -- See Note [Tag inference for interactive contexts] - ; inferTags (stgPipeline_pprOpts opts) logger this_mod binds_sorted_with_fvs + ; inferTags (stgPipeline_pprOpts opts) (stgPipeline_forBytecode opts) logger this_mod binds_sorted_with_fvs } where ===================================== testsuite/tests/simplStg/should_compile/T22840.hs ===================================== @@ -0,0 +1,14 @@ +{-# OPTIONS_GHC -fwrite-if-simplified-core -fbyte-code-and-object-code -fprefer-byte-code #-} +{-# LANGUAGE TemplateHaskell #-} + +module C where + +import T22840A +import T22840B +import Control.Monad.IO.Class + +$(liftIO $ do + putStrLn "start" + putStrLn (disp theT) + putStrLn "end" + return []) ===================================== testsuite/tests/simplStg/should_compile/T22840.stderr ===================================== @@ -0,0 +1,6 @@ +[1 of 3] Compiling T22840A ( T22840A.hs, T22840A.o, T22840A.dyn_o ) +[2 of 3] Compiling T22840B ( T22840B.hs, T22840B.o, T22840B.dyn_o, interpreted ) +[3 of 3] Compiling C ( T22840.hs, T22840.o, T22840.dyn_o, interpreted ) +start +Just +end ===================================== testsuite/tests/simplStg/should_compile/T22840A.hs ===================================== @@ -0,0 +1,9 @@ +module T22840A where + +data T = MkT !(Maybe Bool) + +disp :: T -> String +disp (MkT b) = + case b of + Nothing -> "Nothing" + Just _ -> "Just" ===================================== testsuite/tests/simplStg/should_compile/T22840B.hs ===================================== @@ -0,0 +1,8 @@ +{-# OPTIONS_GHC -fwrite-if-simplified-core -fbyte-code-and-object-code -fprefer-byte-code #-} + +module T22840B where + +import T22840A + +theT :: T +theT = MkT (Just True) ===================================== testsuite/tests/simplStg/should_compile/all.T ===================================== @@ -14,3 +14,7 @@ test('T19717', normal, compile, ['-ddump-stg-final -dsuppress-uniques -dno-typea test('inferTags002', [ only_ways(['optasm']), grep_errmsg(r'(call stg\_ap\_0)', [1])], compile, ['-ddump-cmm -dsuppress-uniques -dno-typeable-binds -O']) test('T22212', normal, compile, ['-O']) +test('T22840', [extra_files( + [ 'T22840A.hs' + , 'T22840B.hs' + ]), when(not(has_dynamic()),skip)], multimod_compile, ['T22840', '-dynamic-too -dtag-inference-checks']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b959ad0b09c764dfb36aa477e45cc2670672e2b6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b959ad0b09c764dfb36aa477e45cc2670672e2b6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 09:50:10 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Fri, 03 Feb 2023 04:50:10 -0500 Subject: [Git][ghc/ghc][wip/9.2.6-backports] 27 commits: Typeable: Fix module locations of some definitions in GHC.Types Message-ID: <63dcd8d2e407b_1108fe526204621d5@gitlab.mail> Zubin pushed to branch wip/9.2.6-backports at Glasgow Haskell Compiler / GHC Commits: e8e9aaac by Matthew Pickering at 2023-02-03T15:19:07+05:30 Typeable: Fix module locations of some definitions in GHC.Types There was some confusion in Data.Typeable about which module certain wired-in things were defined in. Just because something is wired-in doesn't mean it comes from GHC.Prim, in particular things like LiftedRep and RuntimeRep are defined in GHC.Types and that's the end of the story. Things like Int#, Float# etc are defined in GHC.Prim as they have no Haskell definition site at all so we need to generate type representations for them (which live in GHC.Types). Fixes #22510 (cherry picked from commit 1d3a8b8ec98e6eedf8943e19780ec374c2491e7f) - - - - - 82e7b8cc by Andreas Klebinger at 2023-02-03T15:19:07+05:30 Fix LitRubbish being applied to values. This fixes #19824 This is the 9.2 backport of commit 52ce8590ab18fb1fc99bd9aa24c016f786d7f7d1 (cherry picked from commit 2e02959ab40f2b67499aaffc29ee1dc9f0d48158) - - - - - 1c237a73 by Simon Peyton Jones at 2023-02-03T15:19:07+05:30 Fix unifier bug: failing to decompose over-saturated type family This simple patch fixes #22647 (cherry picked from commit 317f45c154f6fe25d50ef2f3febcc5883ff1b1ca) - - - - - 4e9ba78a by Sebastian Graf at 2023-02-03T15:19:07+05:30 Handle shadowing in DmdAnal (#22718) Previously, when we had a shadowing situation like ```hs f x = ... -- demand signature <1L><1L> main = ... \f -> f 1 ... ``` we'd happily use the shadowed demand signature at the call site inside the lambda. Of course, that's wrong and solution is simply to remove the demand signature from the `AnalEnv` when we enter the lambda. This patch does so for all binding constructs Core. In #22718 the issue was caused by LetUp not shadowing away the existing demand signature for the let binder in the let body. The resulting absent error is fickle to reproduce; hence no reproduction test case. #17478 would help. Fixes #22718. It appears that TcPlugin_Rewrite regresses by ~40% on Darwin. It is likely that DmdAnal was exploiting ill-scoped analysis results. Metric increase ['bytes allocated'] (test_env=x86_64-darwin-validate): TcPlugin_Rewrite (cherry picked from commit e3fff7512bbf989386faaa1dccafdad1deabde84) - - - - - ad709014 by Zubin Duggal at 2023-02-03T15:19:07+05:30 Bump bytestring submodule to 0.11.4.0 - - - - - 9ba672ff by Andreas Klebinger at 2023-02-03T15:19:07+05:30 Only gc sparks locally when we can ensure marking is done. When performing GC without work stealing there was no guarantee that spark pruning was happening after marking of the sparks. This could cause us to GC live sparks under certain circumstances. Fixes #22528. (cherry picked from commit a1491c8791c57a64d94bc08d639d585815c8d4e2) - - - - - 7c9223ae by Ian-Woo Kim at 2023-02-03T15:19:07+05:30 Truncate eventlog event for large payload (#20221) RTS eventlog events for postCapsetVecEvent are truncated if payload is larger than EVENT_PAYLOAD_SIZE_MAX Previously, postCapsetVecEvent records eventlog event with payload of variable size larger than EVENT_PAYLOAD_SIZE_MAX (2^16) without any validation, resulting in corrupted data. For example, this happens when a Haskell binary is invoked with very long command line arguments exceeding 2^16 bytes (see #20221). Now we check the size of accumulated payload messages incrementally, and truncate the message just before the payload size exceeds EVENT_PAYLOAD_SIZE_MAX. RTS will warn the user with a message showing how many arguments are truncated. (cherry picked from commit 2057c77d08cb8422857d182a3691f98dccd0c7d6) - - - - - 212cfd57 by Simon Peyton Jones at 2023-02-03T15:19:08+05:30 Make FloatIn robust to shadowing This MR fixes #22622. See the new Note [Shadowing and name capture] I did a bit of refactoring in sepBindsByDropPoint too. The bug doesn't manifest in HEAD, but it did show up in 9.4, so we should backport this patch to 9.4 (cherry picked from commit 6206cb9287f3f6e70c669660a646a65274870d2b) - - - - - 7a0b376d by Ben Gamari at 2023-02-03T15:19:08+05:30 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. (cherry picked from commit f891a442046d8a5ebf4d4777847880ce06752b18) - - - - - 5d45cb39 by Ben Gamari at 2023-02-03T15:19:08+05:30 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. (cherry picked from commit b13c6ea5d4b64841164f8cc58d6c6f3de390f2ed) - - - - - bf76d103 by Oleg Grenrus at 2023-02-03T15:19:08+05:30 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general (cherry picked from commit 1b812b6973a25cb1962e2fc543d2c4ed3cf31f3c) - - - - - 6444163e by Zubin Duggal at 2023-02-03T15:19:08+05:30 Document #22255 and #22468 in bugs.rst - - - - - c50eeb64 by Simon Peyton Jones at 2023-02-03T15:19:08+05:30 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 (cherry picked from commit 3d55d8ab51ece43c51055c43c9e7aba77cce46c0) - - - - - 06baf5ca by Simon Peyton Jones at 2023-02-03T15:19:08+05:30 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. (cherry picked from commit e193e53790dd5886feea3cf4c9c17625d188291b) - - - - - 3f8091ce by Sebastian Graf at 2023-02-03T15:19:08+05:30 DmdAnal: Don't panic in addCaseBndrDmd (#22039) Rather conservatively return Top. See Note [Untyped demand on case-alternative binders]. I also factored `addCaseBndrDmd` into two separate functions `scrutSubDmd` and `fieldBndrDmds`. Fixes #22039. (cherry picked from commit d2be80fd9b222963e8dd09a30f78c106e00da7f9) - - - - - d81534ff by Matthew Pickering at 2023-02-03T15:19:08+05:30 ApplicativeDo: Set pattern location before running exhaustiveness checker This improves the error messages of the exhaustiveness checker when checking statements which have been moved around with ApplicativeDo. Before: Test.hs:2:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 2 | let x = () | ^^^^^^^^^^ After: Test.hs:4:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 4 | ~(Just res1) <- seq x (pure $ Nothing @()) | Fixes #22483 (cherry picked from commit 74c767df770766d8d52e87b9ff7da10f94620a91) (cherry picked from commit 51c6051bcc405bc1dbddd450ade949acd70db6b8) - - - - - c6950cd7 by Andreas Klebinger at 2023-02-03T15:19:08+05:30 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- (cherry picked from commit 08ba87200ff068aa37cac082e61ee7e2d534daf5) - - - - - 1b09e0fe by Matthew Pickering at 2023-02-03T15:19:08+05:30 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s (cherry picked from commit a960ca817d6ad0109ea6edda50da3902cc538e86) - - - - - e2ac0076 by Matthew Pickering at 2023-02-03T15:19:08+05:30 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. (cherry picked from commit 734847108420cf826a807c30ad54651659cf3a08) - - - - - 67919bbc by Matthew Pickering at 2023-02-03T15:19:08+05:30 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes (cherry picked from commit 8c0ea25fb4a27d4729aabf73f4c00b912bb0c58d) - - - - - 5058bcec by Cheng Shao at 2023-02-03T15:19:08+05:30 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. (cherry picked from commit c45a5fffef2c76efbf5d3a009c3f6d0244a63f0d) - - - - - 89610874 by Ben Gamari at 2023-02-03T15:19:08+05:30 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. (cherry picked from commit be417a47c7695998dea0adc05489a7b8838a78b6) - - - - - 01bd2ec5 by Ben Gamari at 2023-02-03T15:19:08+05:30 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. (cherry picked from commit 30989d137b8f3a8fddbfd116e04b48f23c24f86c) - - - - - c0f31c58 by Ben Gamari at 2023-02-03T15:19:08+05:30 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. (cherry picked from commit 7566fd9de38c67360c090f828923d41587af519c) - - - - - 436b7d3e by Ben Gamari at 2023-02-03T15:19:08+05:30 testsuite: Add regression test for #22798 (cherry picked from commit 2cb500a5ee1a31dfe1a2cdd71f175442026eb082) - - - - - 50eff29a by Zubin Duggal at 2023-02-03T15:19:08+05:30 hadrian: enable -haddock in perf flavour (#22734) - - - - - 94dad10d by Zubin Duggal at 2023-02-03T15:19:08+05:30 Testsuite fixes - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/cbits/keepCAFsForGHCi.c - compiler/ghc.mk - configure.ac - docs/users_guide/bugs.rst - hadrian/src/Settings/Flavours/Performance.hs - libraries/bytestring - libraries/ghc-bignum/gmp/gmp-tarballs - + m4/fp_ld_no_fixup_chains.m4 - rts/Sparks.c - rts/eventlog/EventLog.c - rts/sm/GC.c - + testsuite/tests/ado/T22483.hs - + testsuite/tests/ado/T22483.stderr - testsuite/tests/ado/all.T - + testsuite/tests/codeGen/should_run/T22798.hs - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/ghci/T16392/T16392.script - testsuite/tests/ghci/linking/dyn/Makefile - testsuite/tests/ghci/scripts/T9881.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/34dd0823f59b2e9d32b79d84c843b9bc8f158c56...94dad10d174909118bfd210b71d808f9e99f6d31 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/34dd0823f59b2e9d32b79d84c843b9bc8f158c56...94dad10d174909118bfd210b71d808f9e99f6d31 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 10:11:26 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Fri, 03 Feb 2023 05:11:26 -0500 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] Use IO in decoding; Fix memory allocation bug in test setup Message-ID: <63dcddce591f6_1108fe52634475367@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: ea608c2d by Sven Tennie at 2023-02-03T10:10:35+00:00 Use IO in decoding; Fix memory allocation bug in test setup - - - - - 8 changed files: - libraries/ghc-heap/GHC/Exts/DecodeStack.hs - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/cbits/Stack.cmm - libraries/ghc-heap/tests/all.T - libraries/ghc-heap/tests/stack_big_ret.hs - libraries/ghc-heap/tests/stack_misc_closures.hs - libraries/ghc-heap/tests/stack_misc_closures_c.c - libraries/ghc-heap/tests/stack_underflow.hs Changes: ===================================== libraries/ghc-heap/GHC/Exts/DecodeStack.hs ===================================== @@ -35,6 +35,8 @@ import GHC.Exts.Heap.InfoTable import GHC.Exts.StackConstants import GHC.Stack.CloneStack import Prelude +import GHC.IO (IO (..)) +import Data.Array.Byte {- Note [Decoding the stack] ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -101,46 +103,50 @@ foreign import prim "derefStackWordzh" derefStackWord# :: StackSnapshot# -> Word derefStackWord :: StackFrameIter -> Word derefStackWord (StackFrameIter {..}) = W# (derefStackWord# stackSnapshot# (wordOffsetToWord# index)) -foreign import prim "getUpdateFrameTypezh" getUpdateFrameType# :: StackSnapshot# -> Word# -> Word# +foreign import prim "getUpdateFrameTypezh" getUpdateFrameType# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word# #) -getUpdateFrameType :: StackFrameIter -> UpdateFrameType -getUpdateFrameType (StackFrameIter {..}) = (toEnum . fromInteger . toInteger) (W# (getUpdateFrameType# stackSnapshot# (wordOffsetToWord# index))) +getUpdateFrameType :: StackFrameIter -> IO UpdateFrameType +getUpdateFrameType (StackFrameIter {..}) = (toEnum . fromInteger . toInteger) <$> IO (\s -> + case (getUpdateFrameType# stackSnapshot# (wordOffsetToWord# index) s) of (# s1, uft# #) -> (# s1, W# uft# #)) -foreign import prim "getUnderflowFrameNextChunkzh" getUnderflowFrameNextChunk# :: StackSnapshot# -> Word# -> StackSnapshot# +foreign import prim "getUnderflowFrameNextChunkzh" getUnderflowFrameNextChunk# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, StackSnapshot# #) -getUnderflowFrameNextChunk :: StackFrameIter -> StackSnapshot -getUnderflowFrameNextChunk (StackFrameIter {..}) = StackSnapshot s# - where - s# = getUnderflowFrameNextChunk# stackSnapshot# (wordOffsetToWord# index) +getUnderflowFrameNextChunk :: StackFrameIter -> IO StackSnapshot +getUnderflowFrameNextChunk (StackFrameIter {..}) = IO $ \s -> + case getUnderflowFrameNextChunk# stackSnapshot# (wordOffsetToWord# index) s of + (# s1, stack# #) -> (# s1, StackSnapshot stack# #) -foreign import prim "getWordzh" getWord# :: StackSnapshot# -> Word# -> Word# -> Word# +foreign import prim "getWordzh" getWord# :: StackSnapshot# -> Word# -> Word# -> State# RealWorld -> (# State# RealWorld, Word# #) foreign import prim "getAddrzh" getAddr# :: StackSnapshot# -> Word# -> Addr# -getWord :: StackFrameIter -> WordOffset -> Word -getWord (StackFrameIter {..}) relativeOffset = W# (getWord# stackSnapshot# (wordOffsetToWord# index) (wordOffsetToWord# relativeOffset)) +getWord :: StackFrameIter -> WordOffset -> IO Word +getWord (StackFrameIter {..}) relativeOffset = IO $ \s -> + case getWord# stackSnapshot# (wordOffsetToWord# index) (wordOffsetToWord# relativeOffset) s of + (# s1, w# #) -> (# s1, W# w# #) -foreign import prim "getRetFunTypezh" getRetFunType# :: StackSnapshot# -> Word# -> Word# +foreign import prim "getRetFunTypezh" getRetFunType# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word# #) -getRetFunType :: StackFrameIter -> RetFunType -getRetFunType (StackFrameIter {..}) = (toEnum . fromInteger . toInteger) (W# (getRetFunType# stackSnapshot# (wordOffsetToWord# index))) +-- TODO: Could use getWord +getRetFunType :: StackFrameIter -> IO RetFunType +getRetFunType (StackFrameIter {..}) = (toEnum . fromInteger . toInteger) <$> IO (\s -> + case (getRetFunType# stackSnapshot# (wordOffsetToWord# index) s) of (# s1, rft# #) -> (# s1, W# rft# #)) -foreign import prim "getLargeBitmapzh" getLargeBitmap# :: StackSnapshot# -> Word# -> (# ByteArray#, Word# #) +foreign import prim "getLargeBitmapzh" getLargeBitmap# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, ByteArray#, Word# #) -foreign import prim "getBCOLargeBitmapzh" getBCOLargeBitmap# :: StackSnapshot# -> Word# -> (# ByteArray#, Word# #) +foreign import prim "getBCOLargeBitmapzh" getBCOLargeBitmap# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, ByteArray#, Word# #) -foreign import prim "getRetFunLargeBitmapzh" getRetFunLargeBitmap# :: StackSnapshot# -> Word# -> (# ByteArray#, Word# #) +foreign import prim "getRetFunLargeBitmapzh" getRetFunLargeBitmap# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, ByteArray#, Word# #) -foreign import prim "getSmallBitmapzh" getSmallBitmap# :: StackSnapshot# -> Word# -> (# Word#, Word# #) +foreign import prim "getSmallBitmapzh" getSmallBitmap# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word#, Word# #) -foreign import prim "getRetSmallSpecialTypezh" getRetSmallSpecialType# :: StackSnapshot# -> Word# -> Word# +foreign import prim "getRetSmallSpecialTypezh" getRetSmallSpecialType# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word# #) -getRetSmallSpecialType :: StackFrameIter -> SpecialRetSmall -getRetSmallSpecialType (StackFrameIter {..}) = - let special# = getRetSmallSpecialType# stackSnapshot# (wordOffsetToWord# index) - in (toEnum . fromInteger . toInteger) (W# special#) +getRetSmallSpecialType :: StackFrameIter -> IO SpecialRetSmall +getRetSmallSpecialType (StackFrameIter {..}) = (toEnum . fromInteger . toInteger) <$> IO (\s -> + case (getRetSmallSpecialType# stackSnapshot# (wordOffsetToWord# index) s) of (# s1, rft# #) -> (# s1, W# rft# #)) -foreign import prim "getRetFunSmallBitmapzh" getRetFunSmallBitmap# :: StackSnapshot# -> Word# -> (# Word#, Word# #) +foreign import prim "getRetFunSmallBitmapzh" getRetFunSmallBitmap# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word#, Word# #) foreign import prim "advanceStackFrameIterzh" advanceStackFrameIter# :: StackSnapshot# -> Word# -> (# StackSnapshot#, Word#, Int# #) @@ -151,7 +157,7 @@ getInfoTable StackFrameIter {..} = let infoTablePtr = Ptr (getInfoTableAddr# stackSnapshot# (wordOffsetToWord# index)) in peekItbl infoTablePtr -foreign import prim "getBoxedClosurezh" getBoxedClosure# :: StackSnapshot# -> Word# -> Any +foreign import prim "getBoxedClosurezh" getBoxedClosure# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Addr# #) -- -- TODO: Remove this instance (debug only) -- instance Show StackFrameIter where @@ -203,39 +209,42 @@ toBitmapEntries sfi@(StackFrameIter {..}) bitmapWord bSize = } : toBitmapEntries (StackFrameIter stackSnapshot# (index + 1) False) (bitmapWord `shiftR` 1) (bSize - 1) -toBitmapPayload :: BitmapEntry -> Box +toBitmapPayload :: BitmapEntry -> IO Box toBitmapPayload e - | (isPrimitive . closureFrame) e = trace "PRIM" $ StackFrameBox $ (closureFrame e) { + | (isPrimitive . closureFrame) e = trace "PRIM" $ pure . StackFrameBox $ (closureFrame e) { isPrimitive = True } toBitmapPayload e = getClosure (closureFrame e) 0 -getClosure :: StackFrameIter -> WordOffset -> Box -getClosure StackFrameIter {..} relativeOffset = - let !c = (getBoxedClosure# stackSnapshot# (wordOffsetToWord# (index + relativeOffset))) - in - Box c - -decodeLargeBitmap :: (StackSnapshot# -> Word# -> (# ByteArray#, Word# #)) -> StackFrameIter -> WordOffset -> [Box] -decodeLargeBitmap getterFun# sfi@(StackFrameIter {..}) relativePayloadOffset = - let !(# bitmapArray#, size# #) = getterFun# stackSnapshot# (wordOffsetToWord# index) - bitmapWords :: [Word] = byteArrayToList bitmapArray# - in decodeBitmaps sfi relativePayloadOffset bitmapWords (W# size#) - -decodeBitmaps :: StackFrameIter -> WordOffset -> [Word] -> Word -> [Box] +getClosure :: StackFrameIter -> WordOffset -> IO Box +getClosure sfi at StackFrameIter {..} relativeOffset = trace ("getClosure " ++ show sfi ++ " " ++ show relativeOffset) $ + IO $ \s -> + case (getBoxedClosure# stackSnapshot# (wordOffsetToWord# (index + relativeOffset)) s) of (# s1, ptr #) -> + (# s1, Box (unsafeCoerce# ptr) #) + +decodeLargeBitmap :: (StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, ByteArray#, Word# #)) -> StackFrameIter -> WordOffset -> IO [Box] +decodeLargeBitmap getterFun# sfi@(StackFrameIter {..}) relativePayloadOffset = do + (bitmapArray, size) <- IO $ \s -> + case getterFun# stackSnapshot# (wordOffsetToWord# index) s of + (# s1, ba#, s# #) -> (# s1, (ByteArray ba#, W# s#) #) + let bitmapWords :: [Word] = byteArrayToList bitmapArray + decodeBitmaps sfi relativePayloadOffset bitmapWords size + +decodeBitmaps :: StackFrameIter -> WordOffset -> [Word] -> Word -> IO [Box] decodeBitmaps (StackFrameIter {..}) relativePayloadOffset bitmapWords size = let bes = wordsToBitmapEntries (StackFrameIter stackSnapshot# (index + relativePayloadOffset) False) bitmapWords size - in map toBitmapPayload bes - -decodeSmallBitmap :: (StackSnapshot# -> Word# -> (# Word#, Word# #)) -> StackFrameIter -> WordOffset -> [Box] -decodeSmallBitmap getterFun# sfi@(StackFrameIter {..}) relativePayloadOffset = - let !(# bitmap#, size# #) = getterFun# stackSnapshot# (wordOffsetToWord# index) - size = W# size# - bitmapWords = if size > 0 then [(W# bitmap#)] else [] - in decodeBitmaps sfi relativePayloadOffset bitmapWords size - -byteArrayToList :: ByteArray# -> [Word] -byteArrayToList bArray = go 0 + in mapM toBitmapPayload bes + +decodeSmallBitmap :: (StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word#, Word# #)) -> StackFrameIter -> WordOffset -> IO [Box] +decodeSmallBitmap getterFun# sfi@(StackFrameIter {..}) relativePayloadOffset = do + (bitmap, size) <- IO $ \s -> + case getterFun# stackSnapshot# (wordOffsetToWord# index) s of + (# s1, b# , s# #) -> (# s1, (W# b# , W# s#) #) + let bitmapWords = if size > 0 then [bitmap] else [] + decodeBitmaps sfi relativePayloadOffset bitmapWords size + +byteArrayToList :: ByteArray -> [Word] +byteArrayToList (ByteArray bArray) = go 0 where go i | i < maxIndex = (W# (indexWordArray# bArray (toInt# i))) : (go (i + 1)) @@ -246,82 +255,104 @@ wordOffsetToWord# :: WordOffset -> Word# wordOffsetToWord# wo = intToWord# (fromIntegral wo) unpackStackFrameIter :: StackFrameIter -> IO Closure -unpackStackFrameIter sfi | isPrimitive sfi = pure $ UnknownTypeWordSizedPrimitive (getWord sfi 0) +unpackStackFrameIter sfi | isPrimitive sfi = UnknownTypeWordSizedPrimitive <$> (getWord sfi 0) unpackStackFrameIter sfi = do - info <- getInfoTable sfi traceM $ "unpackStackFrameIter - sfi " ++ show sfi - traceM $ "unpackStackFrameIter - unpacked " ++ show (unpackStackFrameIter' info) - pure $ unpackStackFrameIter' info + info <- getInfoTable sfi + res <- unpackStackFrameIter' info + traceM $ "unpackStackFrameIter - unpacked " ++ show res + pure res where - unpackStackFrameIter' :: StgInfoTable -> Closure + unpackStackFrameIter' :: StgInfoTable -> IO Closure unpackStackFrameIter' info = case tipe info of - RET_BCO -> - RetBCO + RET_BCO -> do + bco' <- getClosure sfi offsetStgClosurePayload + -- The arguments begin directly after the payload's one element + bcoArgs' <- decodeLargeBitmap getBCOLargeBitmap# sfi (offsetStgClosurePayload + 1) + pure $ RetBCO { info = info, - bco = getClosure sfi offsetStgClosurePayload, - -- The arguments begin directly after the payload's one element - bcoArgs = decodeLargeBitmap getBCOLargeBitmap# sfi (offsetStgClosurePayload + 1) + bco = bco', + bcoArgs = bcoArgs' } RET_SMALL -> - trace "RET_SMALL" $ - RetSmall + trace "RET_SMALL" $ do + payload' <- decodeSmallBitmap getSmallBitmap# sfi offsetStgClosurePayload + knownRetSmallType' <- getRetSmallSpecialType sfi + pure $ RetSmall { info = info, - knownRetSmallType = getRetSmallSpecialType sfi, - payload = decodeSmallBitmap getSmallBitmap# sfi offsetStgClosurePayload + knownRetSmallType = knownRetSmallType', + payload = payload' } - RET_BIG -> - RetBig + RET_BIG -> do + payload' <- decodeLargeBitmap getLargeBitmap# sfi offsetStgClosurePayload + pure $ RetBig { info = info, - payload = decodeLargeBitmap getLargeBitmap# sfi offsetStgClosurePayload + payload = payload' } - RET_FUN -> - RetFun + RET_FUN -> do + retFunType' <- getRetFunType sfi + retFunSize' <- getWord sfi offsetStgRetFunFrameSize + retFunFun' <- getClosure sfi offsetStgRetFunFrameFun + retFunPayload' <- + if retFunType' == ARG_GEN_BIG + then decodeLargeBitmap getRetFunLargeBitmap# sfi offsetStgRetFunFramePayload + else decodeSmallBitmap getRetFunSmallBitmap# sfi offsetStgRetFunFramePayload + pure $ RetFun { info = info, - retFunType = getRetFunType sfi, - retFunSize = getWord sfi offsetStgRetFunFrameSize, - retFunFun = getClosure sfi offsetStgRetFunFrameFun, - retFunPayload = - if getRetFunType sfi == ARG_GEN_BIG - then decodeLargeBitmap getRetFunLargeBitmap# sfi offsetStgRetFunFramePayload - else decodeSmallBitmap getRetFunSmallBitmap# sfi offsetStgRetFunFramePayload + retFunType = retFunType', + retFunSize = retFunSize', + retFunFun = retFunFun', + retFunPayload = retFunPayload' } - UPDATE_FRAME -> - UpdateFrame + UPDATE_FRAME -> do + updatee' <- getClosure sfi offsetStgUpdateFrameUpdatee + knownUpdateFrameType' <- getUpdateFrameType sfi + pure $ UpdateFrame { info = info, - knownUpdateFrameType = getUpdateFrameType sfi, - updatee = getClosure sfi offsetStgUpdateFrameUpdatee + knownUpdateFrameType = knownUpdateFrameType', + updatee = updatee' } - CATCH_FRAME -> - CatchFrame + CATCH_FRAME -> do + exceptions_blocked' <- getWord sfi offsetStgCatchFrameExceptionsBlocked + handler' <- getClosure sfi offsetStgCatchFrameHandler + pure $ CatchFrame { info = info, - exceptions_blocked = getWord sfi offsetStgCatchFrameExceptionsBlocked, - handler = getClosure sfi offsetStgCatchFrameHandler + exceptions_blocked = exceptions_blocked', + handler = handler' } - UNDERFLOW_FRAME -> - UnderflowFrame + UNDERFLOW_FRAME -> do + nextChunk' <- getUnderflowFrameNextChunk sfi + pure $ UnderflowFrame { info = info, - nextChunk = getUnderflowFrameNextChunk sfi + nextChunk = nextChunk' } - STOP_FRAME -> StopFrame {info = info} - ATOMICALLY_FRAME -> - AtomicallyFrame + STOP_FRAME -> pure $ StopFrame {info = info} + ATOMICALLY_FRAME -> do + atomicallyFrameCode' <- getClosure sfi offsetStgAtomicallyFrameCode + result' <- getClosure sfi offsetStgAtomicallyFrameResult + pure $ AtomicallyFrame { info = info, - atomicallyFrameCode = getClosure sfi offsetStgAtomicallyFrameCode, - result = getClosure sfi offsetStgAtomicallyFrameResult + atomicallyFrameCode = atomicallyFrameCode', + result = result' } - CATCH_RETRY_FRAME -> - CatchRetryFrame + CATCH_RETRY_FRAME -> do + running_alt_code' <- getWord sfi offsetStgCatchRetryFrameRunningAltCode + first_code' <- getClosure sfi offsetStgCatchRetryFrameRunningFirstCode + alt_code' <- getClosure sfi offsetStgCatchRetryFrameAltCode + pure $ CatchRetryFrame { info = info, - running_alt_code = getWord sfi offsetStgCatchRetryFrameRunningAltCode, - first_code = getClosure sfi offsetStgCatchRetryFrameRunningFirstCode, - alt_code = getClosure sfi offsetStgCatchRetryFrameAltCode + running_alt_code = running_alt_code', + first_code = first_code', + alt_code = alt_code' } - CATCH_STM_FRAME -> - CatchStmFrame + CATCH_STM_FRAME -> do + catchFrameCode' <- getClosure sfi offsetStgCatchSTMFrameCode + handler' <- getClosure sfi offsetStgCatchSTMFrameHandler + pure $ CatchStmFrame { info = info, - catchFrameCode = getClosure sfi offsetStgCatchSTMFrameCode, - handler = getClosure sfi offsetStgCatchSTMFrameHandler + catchFrameCode = catchFrameCode', + handler = handler' } x -> error $ "Unexpected closure type on stack: " ++ show x ===================================== libraries/ghc-heap/GHC/Exts/Heap.hs ===================================== @@ -182,8 +182,8 @@ getClosureDataFromHeapObject x = do -- | Like 'getClosureData', but taking a 'Box', so it is easier to work with. getBoxedClosureData :: Box -> IO Closure -getBoxedClosureData (Box a) = let !a' = a - in getClosureData a' +getBoxedClosureData (Box a) = getClosureData a + #if MIN_TOOL_VERSION_ghc(9,5,0) getBoxedClosureData b@(StackFrameBox sfi) = trace ("unpack " ++ show b) $ unpackStackFrameIter sfi #endif ===================================== libraries/ghc-heap/cbits/Stack.cmm ===================================== @@ -177,7 +177,6 @@ getInfoTableAddrzh(P_ stack, W_ offsetWords){ // Just a cast stackSnapshotToWordzh(P_ stack) { - ccall checkSTACK(stack); return (stack); } @@ -188,19 +187,17 @@ eqStackSnapshotszh(P_ stack1, P_ stack2) { } getBoxedClosurezh(P_ stack, W_ offsetWords){ + ccall debugBelch("getBoxedClosurezh - stack %p , offsetWords %lu", stack, offsetWords); + ccall checkSTACK(stack); P_ ptr; ptr = StgStack_sp(stack) + WDS(offsetWords); P_ box; (box) = ccall getBoxedClosure(MyCapability(), ptr); + ccall debugBelch("getBoxedClosurezh - box %p", box); return (box); } INFO_TABLE_CONSTR(box, 1, 0, 0, CONSTR_1_0, "BOX", "BOX") { foreign "C" barf("BOX object (%p) entered!", R1) never returns; } - -checkSanityzh(I64 a, I64 b){ - ccall checkSanity(a,b); - return (42); -} ===================================== libraries/ghc-heap/tests/all.T ===================================== @@ -102,5 +102,5 @@ test('stack_misc_closures', [ ('stack_misc_closures_c.c', '') ,('stack_misc_closures_prim.cmm', '') ] - , '-debug -optc-g -optc-O0 -g -ddump-to-file -dlint -ddump-cmm' + , '-debug -optc-g -optc-O0 -g -ddump-to-file -dlint -ddump-cmm' # -with-rtsopts="-Dg -Ds -Db"' ]) ===================================== libraries/ghc-heap/tests/stack_big_ret.hs ===================================== @@ -36,8 +36,8 @@ main = do bigFun (cloneStackReturnInt stackRef) 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 mbStackSnapshot <- readIORef stackRef - let stackSnapshot = fromJust mbStackSnapshot - (SimpleStack boxedFrames) <- decodeStack stackSnapshot + let stackSnapshot@(StackSnapshot s#) = fromJust mbStackSnapshot + (SimpleStack boxedFrames) <- getClosureData s# stackFrames <- mapM getBoxedClosureData boxedFrames assertStackInvariants stackSnapshot stackFrames ===================================== libraries/ghc-heap/tests/stack_misc_closures.hs ===================================== @@ -62,8 +62,6 @@ foreign import ccall "maxSmallBitmapBits" maxSmallBitmapBits_c :: Word foreign import ccall "belchStack" belchStack# :: StackSnapshot# -> IO () -foreign import prim "checkSanityzh" checkSanity# :: Int# -> Int# -> State# RealWorld -> (# State# RealWorld, Int# #) - {- Test stategy ~~~~~~~~~~~~ @@ -318,9 +316,10 @@ type SetupFunction = State# RealWorld -> (# State# RealWorld, StackSnapshot# #) test :: HasCallStack => SetupFunction -> (Closure -> IO ()) -> IO () test setup assertion = do - checkSanity 1# 1# + traceM $ "test - getStackSnapshot" sn@(StackSnapshot sn#) <- getStackSnapshot setup traceM $ "test - sn " ++ show sn + performGC traceM $ "entertainGC - " ++ (entertainGC 10) -- Run garbage collection now, to prevent later surprises: It's hard to debug -- when the GC suddenly does it's work and there were bad closures or pointers. @@ -329,11 +328,9 @@ test setup assertion = do traceM $ "test - sn' " ++ show sn ss@(SimpleStack boxedFrames) <- getClosureData sn# traceM $ "test - ss" ++ show ss - checkSanity 1# 1# performGC traceM $ "call getBoxedClosureData" stack <- mapM getBoxedClosureData boxedFrames - checkSanity 1# 1# performGC assert sn stack -- The result of HasHeapRep should be similar (wrapped in the closure for @@ -366,11 +363,9 @@ entertainGC x = show x ++ entertainGC (x -1) testSize :: HasCallStack => SetupFunction -> Int -> IO () testSize setup expectedSize = do - checkSanity 1# 1# (StackSnapshot sn#) <- getStackSnapshot setup (SimpleStack boxedFrames) <- getClosureData sn# assertEqual expectedSize =<< closureSize (head boxedFrames) - void $ checkSanity 1# 1# -- | Get a `StackSnapshot` from test setup -- @@ -380,10 +375,6 @@ getStackSnapshot :: SetupFunction -> IO StackSnapshot getStackSnapshot action# = IO $ \s -> case action# s of (# s1, stack #) -> (# s1, StackSnapshot stack #) -checkSanity :: Int# -> Int# -> IO Int -checkSanity b1# b2# = IO $ \s -> - case checkSanity# b1# b2# s of (# s1, r1 #) -> (# s1, I# r1 #) - assertConstrClosure :: HasCallStack => Word -> Closure -> IO () assertConstrClosure w c = case c of ConstrClosure {..} -> do ===================================== libraries/ghc-heap/tests/stack_misc_closures_c.c ===================================== @@ -245,15 +245,15 @@ void create_any_bco_frame(Capability *cap, StgStack *stack, StgWord w) { // Import from Sanity.c extern void checkSTACK(StgStack *stack); +// Basically, a stripped down version of createThread() (regarding stack +// creation) StgStack *setup(Capability *cap, StgWord closureSizeWords, void (*f)(Capability *, StgStack *, StgWord)) { - checkSanity(1, 1); StgWord totalSizeWords = sizeofW(StgStack) + closureSizeWords + MIN_STACK_WORDS; StgStack *stack = (StgStack *)allocate(cap, totalSizeWords); - StgWord totalSizeBytes = WDS(totalSizeWords); SET_HDR(stack, &stg_STACK_info, CCS_SYSTEM); - stack->stack_size = totalSizeBytes; + stack->stack_size = totalSizeWords - sizeofW(StgStack); stack->dirty = 0; stack->marking = 0; @@ -271,7 +271,6 @@ StgStack *setup(Capability *cap, StgWord closureSizeWords, // Make a sanitiy check to find unsound closures before the GC and the decode // code. checkSTACK(stack); - checkSanity(1, 1); return stack; } ===================================== libraries/ghc-heap/tests/stack_underflow.hs ===================================== @@ -37,7 +37,7 @@ isUnderflowFrame _ = False assertStackChunksAreDecodable :: HasCallStack => [Closure] -> IO () assertStackChunksAreDecodable s = do let underflowFrames = filter isUnderflowFrame s - framesOfChunks <- mapM (decodeStack . nextChunk) underflowFrames + let framesOfChunks = map (stackClosures . decodeStack . nextChunk) underflowFrames assertThat "No empty stack chunks" (== True) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ea608c2d3df40d7818c71b332fe4aa6b03e587f3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ea608c2d3df40d7818c71b332fe4aa6b03e587f3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 10:23:46 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 03 Feb 2023 05:23:46 -0500 Subject: [Git][ghc/ghc][master] Enable tables next to code for LoongArch64 Message-ID: <63dce0b288bd2_1108fe526484813e1@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 4 changed files: - compiler/GHC/CmmToLlvm/Mangler.hs - compiler/ghc.cabal.in - libraries/ghci/GHCi/InfoTable.hsc - m4/ghc_tables_next_to_code.m4 Changes: ===================================== compiler/GHC/CmmToLlvm/Mangler.hs ===================================== @@ -38,7 +38,7 @@ llvmFixupAsm platform f1 f2 = {-# SCC "llvm_mangler" #-} -- | These are the rewrites that the mangler will perform rewrites :: [Rewrite] -rewrites = [rewriteSymType, rewriteAVX, rewriteCall] +rewrites = [rewriteSymType, rewriteAVX, rewriteCall, rewriteJump] type Rewrite = Platform -> B.ByteString -> Maybe B.ByteString @@ -123,6 +123,29 @@ rewriteCall platform l removePlt = replaceOnce (B.pack "@plt") (B.pack "") appendInsn i = (`B.append` B.pack ("\n\t" ++ i)) +-- | This rewrites bl and b jump inst to avoid creating PLT entries for +-- functions on loongarch64, because there is no separate call instruction +-- for function calls in loongarch64. Also, this replacement will load +-- the function address from the GOT, which is resolved to point to the +-- real address of the function. +rewriteJump :: Rewrite +rewriteJump platform l + | not isLoongArch64 = Nothing + | isBL l = Just $ replaceJump "bl" "$ra" "$ra" l + | isB l = Just $ replaceJump "b" "$zero" "$t0" l + | otherwise = Nothing + where + isLoongArch64 = platformArch platform == ArchLoongArch64 + isBL = B.isPrefixOf (B.pack "bl\t") + isB = B.isPrefixOf (B.pack "b\t") + + replaceJump jump rd rj l = + appendInsn ("jirl" ++ "\t" ++ rd ++ ", " ++ rj ++ ", 0") $ removeBracket $ + replaceOnce (B.pack (jump ++ "\t%plt(")) (B.pack ("la\t" ++ rj ++ ", ")) l + where + removeBracket = replaceOnce (B.pack ")") (B.pack "") + appendInsn i = (`B.append` B.pack ("\n\t" ++ i)) + -- | @replaceOnce match replace bs@ replaces the first occurrence of the -- substring @match@ in @bs@ with @replace at . replaceOnce :: B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString ===================================== compiler/ghc.cabal.in ===================================== @@ -557,6 +557,7 @@ Library GHC.Platform.ARM GHC.Platform.AArch64 GHC.Platform.Constants + GHC.Platform.LoongArch64 GHC.Platform.NoRegs GHC.Platform.PPC GHC.Platform.Profile @@ -564,7 +565,6 @@ Library GHC.Platform.Reg.Class GHC.Platform.Regs GHC.Platform.RISCV64 - GHC.Platform.LoongArch64 GHC.Platform.S390X GHC.Platform.Wasm32 GHC.Platform.Ways ===================================== libraries/ghci/GHCi/InfoTable.hsc ===================================== @@ -228,6 +228,15 @@ mkJumpToAddr a = case hostPlatformArch of , fromIntegral w64 , fromIntegral (w64 `shiftR` 32) ] + ArchLoongArch64 -> pure $ + let w64 = fromIntegral (funPtrToInt a) :: Word64 + in Right [ 0x1c00000c -- pcaddu12i $t0,0 + , 0x28c0418c -- ld.d $t0,$t0,16 + , 0x4c000180 -- jr $t0 + , 0x03400000 -- nop + , fromIntegral w64 + , fromIntegral (w64 `shiftR` 32) ] + arch -> -- The arch isn't supported. You either need to add your architecture as a -- distinct case, or use non-TABLES_NEXT_TO_CODE mode. ===================================== m4/ghc_tables_next_to_code.m4 ===================================== @@ -17,7 +17,7 @@ AC_DEFUN([GHC_TABLES_NEXT_TO_CODE], case "$Unregisterised" in NO) case "$TargetArch" in - ia64|powerpc64|powerpc64le|s390x|wasm32|loongarch64) + ia64|powerpc64|powerpc64le|s390x|wasm32) TablesNextToCodeDefault=NO AC_MSG_RESULT([no]) ;; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e2d3eb507da184cf3337d36715fd82a81643d91 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e2d3eb507da184cf3337d36715fd82a81643d91 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 10:24:26 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 03 Feb 2023 05:24:26 -0500 Subject: [Git][ghc/ghc][master] Move pthread and timerfd ticker implementations to separate files Message-ID: <63dce0dac37b1_1108fe12881c084848dd@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 3 changed files: - rts/posix/Ticker.c - rts/posix/ticker/Pthread.c - + rts/posix/ticker/TimerFd.c Changes: ===================================== rts/posix/Ticker.c ===================================== @@ -65,13 +65,17 @@ * On Linux we can use timerfd_* (introduced in Linux * 2.6.25) and a thread instead of alarm signals. It avoids the risk of * interrupting syscalls (see #10840) and the risk of being accidentally - * modified in user code using signals. + * modified in user code using signals. NetBSD has also added timerfd + * support since version 10. + * + * For older version of linux/netbsd without timerfd we fall back to the + * pthread based implementation. */ -#if defined(linux_HOST_OS) && HAVE_SYS_TIMERFD_H -#define USE_PTHREAD_FOR_ITIMER +#if HAVE_SYS_TIMERFD_H +#define USE_TIMERFD_FOR_ITIMER #endif -#if defined(freebsd_HOST_OS) +#if defined(linux_HOST_OS) #define USE_PTHREAD_FOR_ITIMER #endif @@ -79,6 +83,10 @@ #define USE_PTHREAD_FOR_ITIMER #endif +#if defined(freebsd_HOST_OS) +#define USE_PTHREAD_FOR_ITIMER +#endif + #if defined(solaris2_HOST_OS) /* USE_TIMER_CREATE is usually disabled for Solaris. In fact it is supported well on this OS, but requires additional privilege. When @@ -98,7 +106,9 @@ ghc-stage2: timer_create: Not owner #endif /* solaris2_HOST_OS */ // Select the variant to use -#if defined(USE_PTHREAD_FOR_ITIMER) +#if defined(USE_TIMERFD_FOR_ITIMER) +#include "ticker/TimerFd.c" +#elif defined(USE_PTHREAD_FOR_ITIMER) #include "ticker/Pthread.c" #elif defined(USE_TIMER_CREATE) #include "ticker/TimerCreate.c" ===================================== rts/posix/ticker/Pthread.c ===================================== @@ -63,13 +63,6 @@ #include #include -#if defined(HAVE_SYS_TIMERFD_H) -#include -#define USE_TIMERFD_FOR_ITIMER 1 -#else -#define USE_TIMERFD_FOR_ITIMER 0 -#endif - /* * TFD_CLOEXEC has been added in Linux 2.6.26. * If it is not available, we use fcntl(F_SETFD). @@ -93,61 +86,16 @@ static Condition start_cond; static Mutex mutex; 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) { - if (poll(pollfds, 2, -1) == -1) { - sysErrorBelch("Ticker: poll failed: %s", strerror(errno)); - } - - // 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) { - sysErrorBelch("Ticker: sleep failed: %s", strerror(errno)); - } + if (rtsSleep(itimer_interval) != 0) { + sysErrorBelch("Ticker: sleep failed: %s", strerror(errno)); } // first try a cheap test @@ -164,10 +112,6 @@ static void *itimer_thread_func(void *_handle_tick) } } - if (USE_TIMERFD_FOR_ITIMER) { - close(timerfd); - } - return NULL; } @@ -186,39 +130,6 @@ initTicker (Time interval, TickProc handle_tick) initCondition(&start_cond); initMutex(&mutex); - /* Open the file descriptor for the timer synchronously. - * - * We used to do it in itimer_thread_func (i.e. in the timer thread) but it - * meant that some user code could run before it and get confused by the - * allocation of the timerfd. - * - * See hClose002 which unsafely closes a file descriptor twice expecting an - * exception the second time: it sometimes failed when the second call to - * "close" closed our own timerfd which inadvertently reused the same file - * descriptor closed by the first call! (see #20618) - */ -#if USE_TIMERFD_FOR_ITIMER - struct itimerspec it; - it.it_value.tv_sec = TimeToSeconds(itimer_interval); - it.it_value.tv_nsec = TimeToNS(itimer_interval) % 1000000000; - it.it_interval = it.it_value; - - timerfd = timerfd_create(CLOCK_MONOTONIC, TFD_CLOEXEC); - if (timerfd == -1) { - barf("timerfd_create: %s", strerror(errno)); - } - if (!TFD_CLOEXEC) { - fcntl(timerfd, F_SETFD, FD_CLOEXEC); - } - if (timerfd_settime(timerfd, 0, &it, NULL)) { - barf("timerfd_settime: %s", strerror(errno)); - } - - if (pipe(pipefds) < 0) { - barf("pipe: %s", strerror(errno)); - } -#endif - /* * Create the thread with all blockable signals blocked, leaving signal * handling to the main and/or other threads. This is especially useful in @@ -269,21 +180,9 @@ 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 { ===================================== rts/posix/ticker/TimerFd.c ===================================== @@ -0,0 +1,280 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1995-2023 + * + * Interval timer for profiling and pre-emptive scheduling. + * + * ---------------------------------------------------------------------------*/ + +/* + * We use a realtime timer by default. I found this much more + * reliable than a CPU timer: + * + * Experiments with different frequencies: using + * CLOCK_REALTIME/CLOCK_MONOTONIC on Linux 2.6.32, + * 1000us has <1% impact on runtime + * 100us has ~2% impact on runtime + * 10us has ~40% impact on runtime + * + * using CLOCK_PROCESS_CPUTIME_ID on Linux 2.6.32, + * I cannot get it to tick faster than 10ms (10000us) + * which isn't great for profiling. + * + * In the threaded RTS, we can't tick in CPU time because the thread + * which has the virtual timer might be idle, so the tick would never + * fire. Therefore we used to tick in realtime in the threaded RTS and + * in CPU time otherwise, but now we always tick in realtime, for + * several reasons: + * + * - resolution (see above) + * - consistency (-threaded is the same as normal) + * - more consistency: Windows only has a realtime timer + * + * Note we want to use CLOCK_MONOTONIC rather than CLOCK_REALTIME, + * because the latter may jump around (NTP adjustments, leap seconds + * etc.). + */ + +#include "rts/PosixSource.h" +#include "Rts.h" + +#include "Ticker.h" +#include "RtsUtils.h" +#include "Proftimer.h" +#include "Schedule.h" +#include "posix/Clock.h" +#include + +#include +#if HAVE_SYS_TIME_H +# include +#endif + +#if defined(HAVE_SIGNAL_H) +# include +#endif + +#include + +#include +#if defined(HAVE_PTHREAD_NP_H) +#include +#endif +#include +#include + +#include + + +/* + * TFD_CLOEXEC has been added in Linux 2.6.26. + * If it is not available, we use fcntl(F_SETFD). + */ +#if !defined(TFD_CLOEXEC) +#define TFD_CLOEXEC 0 +#endif + +static Time itimer_interval = DEFAULT_TICK_INTERVAL; + +// Should we be firing ticks? +// Writers to this must hold the mutex below. +static bool stopped = false; + +// should the ticker thread exit? +// This can be set without holding the mutex. +static bool exited = true; + +// Signaled when we want to (re)start the timer +static Condition start_cond; +static Mutex mutex; +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]; + + pollfds[0].fd = pipefds[0]; + pollfds[0].events = POLLIN; + pollfds[1].fd = timerfd; + pollfds[1].events = POLLIN; + + // 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 (poll(pollfds, 2, -1) == -1) { + sysErrorBelch("Ticker: poll failed: %s", strerror(errno)); + } + + // 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); + } + } + + // first try a cheap test + TSAN_ANNOTATE_BENIGN_RACE(&stopped, "itimer_thread_func"); + if (RELAXED_LOAD(&stopped)) { + OS_ACQUIRE_LOCK(&mutex); + // should we really stop? + if (stopped) { + waitCondition(&start_cond, &mutex); + } + OS_RELEASE_LOCK(&mutex); + } else { + handle_tick(0); + } + } + + close(timerfd); + return NULL; +} + +void +initTicker (Time interval, TickProc handle_tick) +{ + itimer_interval = interval; + stopped = true; + exited = false; +#if defined(HAVE_SIGNAL_H) + sigset_t mask, omask; + int sigret; +#endif + int ret; + + initCondition(&start_cond); + initMutex(&mutex); + + /* Open the file descriptor for the timer synchronously. + * + * We used to do it in itimer_thread_func (i.e. in the timer thread) but it + * meant that some user code could run before it and get confused by the + * allocation of the timerfd. + * + * See hClose002 which unsafely closes a file descriptor twice expecting an + * exception the second time: it sometimes failed when the second call to + * "close" closed our own timerfd which inadvertently reused the same file + * descriptor closed by the first call! (see #20618) + */ + struct itimerspec it; + it.it_value.tv_sec = TimeToSeconds(itimer_interval); + it.it_value.tv_nsec = TimeToNS(itimer_interval) % 1000000000; + it.it_interval = it.it_value; + + timerfd = timerfd_create(CLOCK_MONOTONIC, TFD_CLOEXEC); + if (timerfd == -1) { + barf("timerfd_create: %s", strerror(errno)); + } + if (!TFD_CLOEXEC) { + fcntl(timerfd, F_SETFD, FD_CLOEXEC); + } + if (timerfd_settime(timerfd, 0, &it, NULL)) { + barf("timerfd_settime: %s", strerror(errno)); + } + + if (pipe(pipefds) < 0) { + barf("pipe: %s", strerror(errno)); + } + + /* + * Create the thread with all blockable signals blocked, leaving signal + * handling to the main and/or other threads. This is especially useful in + * the non-threaded runtime, where applications might expect sigprocmask(2) + * to effectively block signals. + */ +#if defined(HAVE_SIGNAL_H) + sigfillset(&mask); + sigret = pthread_sigmask(SIG_SETMASK, &mask, &omask); +#endif + ret = createAttachedOSThread(&thread, "ghc_ticker", itimer_thread_func, (void*)handle_tick); +#if defined(HAVE_SIGNAL_H) + if (sigret == 0) + pthread_sigmask(SIG_SETMASK, &omask, NULL); +#endif + + if (ret != 0) { + barf("Ticker: Failed to spawn thread: %s", strerror(errno)); + } +} + +void +startTicker(void) +{ + OS_ACQUIRE_LOCK(&mutex); + RELAXED_STORE(&stopped, false); + signalCondition(&start_cond); + OS_RELEASE_LOCK(&mutex); +} + +/* There may be at most one additional tick fired after a call to this */ +void +stopTicker(void) +{ + OS_ACQUIRE_LOCK(&mutex); + RELAXED_STORE(&stopped, true); + OS_RELEASE_LOCK(&mutex); +} + +/* There may be at most one additional tick fired after a call to this */ +void +exitTicker (bool wait) +{ + ASSERT(!SEQ_CST_LOAD(&exited)); + SEQ_CST_STORE(&exited, true); + // ensure that ticker wakes up if stopped + startTicker(); + + // wait for ticker to terminate if necessary + if (wait) { + // 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)); + } + + if (pthread_join(thread, NULL)) { + sysErrorBelch("Ticker: Failed to join: %s", strerror(errno)); + } + + // 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]); + + closeMutex(&mutex); + closeCondition(&start_cond); + } else { + pthread_detach(thread); + } +} + +int +rtsTimerSignal(void) +{ + return SIGALRM; +} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2931712a127423c0ab7ac94c7d96dfa8d6c446b6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2931712a127423c0ab7ac94c7d96dfa8d6c446b6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 10:25:02 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 03 Feb 2023 05:25:02 -0500 Subject: [Git][ghc/ghc][master] base: Fix Note references in GHC.IO.Handle.Types Message-ID: <63dce0fe20885_1108fe722f5544881bc@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 1 changed file: - libraries/base/GHC/IO/Handle/Types.hs Changes: ===================================== libraries/base/GHC/IO/Handle/Types.hs ===================================== @@ -124,11 +124,11 @@ data Handle__ Handle__ { haDevice :: !dev, haType :: HandleType, -- type (read/write/append etc.) - haByteBuffer :: !(IORef (Buffer Word8)), -- See [note Buffering Implementation] + haByteBuffer :: !(IORef (Buffer Word8)), -- See Note [Buffering Implementation] haBufferMode :: BufferMode, haLastDecode :: !(IORef (dec_state, Buffer Word8)), -- ^ The byte buffer just before we did our last batch of decoding. - haCharBuffer :: !(IORef (Buffer CharBufElem)), -- See [note Buffering Implementation] + haCharBuffer :: !(IORef (Buffer CharBufElem)), -- See Note [Buffering Implementation] haBuffers :: !(IORef (BufferList CharBufElem)), -- spare buffers haEncoder :: Maybe (TextEncoder enc_state), haDecoder :: Maybe (TextDecoder dec_state), @@ -261,13 +261,13 @@ data BufferMode ) {- -[note Buffering Implementation] - +Note [Buffering Implementation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Each Handle has two buffers: a byte buffer (haByteBuffer) and a Char buffer (haCharBuffer). -[note Buffered Reading] - +Note [Buffered Reading] +~~~~~~~~~~~~~~~~~~~~~~~ For read Handles, bytes are read into the byte buffer, and immediately decoded into the Char buffer (see GHC.IO.Handle.Internals.readTextDevice). The only way there might be @@ -279,8 +279,8 @@ reading data into a Handle. When reading, we can always just read all the data there is available without blocking, decode it into the Char buffer, and then provide it immediately to the caller. -[note Buffered Writing] - +Note [Buffered Writing] +~~~~~~~~~~~~~~~~~~~~~~~ Characters are written into the Char buffer by e.g. hPutStr. At the end of the operation, or when the char buffer is full, the buffer is decoded to the byte buffer (see writeCharBuffer). This is so that we @@ -288,8 +288,8 @@ can detect encoding errors at the right point. Hence, the Char buffer is always empty between Handle operations. -[note Buffer Sizing] - +Note [Buffer Sizing] +~~~~~~~~~~~~~~~~~~~~ The char buffer is always a default size (dEFAULT_CHAR_BUFFER_SIZE). The byte buffer size is chosen by the underlying device (via its IODevice.newBuffer). Hence the size of these buffers is not under @@ -322,8 +322,8 @@ writeCharBuffer, which checks whether the buffer should be flushed according to the current buffering mode. Additionally, we look for newlines and flush if the mode is LineBuffering. -[note Buffer Flushing] - +Note [Buffer Flushing] +~~~~~~~~~~~~~~~~~~~~~~ ** Flushing the Char buffer We must be able to flush the Char buffer, in order to implement View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/41c4baf84e8bf77588be92ef5d4c72add3971656 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/41c4baf84e8bf77588be92ef5d4c72add3971656 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 10:25:39 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 03 Feb 2023 05:25:39 -0500 Subject: [Git][ghc/ghc][master] Bump submodule containers to 0.6.7 Message-ID: <63dce123bb8ab_1108fe722f554491681@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 1 changed file: - libraries/containers Changes: ===================================== libraries/containers ===================================== @@ -1 +1 @@ -Subproject commit fbafcf704f0febd9ddac84dbe00ae3787af43550 +Subproject commit 9f4a93604c66a5e605ce46fc30003b71802b3cfd View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3135819847aae0cdcc6c2fca4a2234fcfed1db93 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3135819847aae0cdcc6c2fca4a2234fcfed1db93 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 10:26:17 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 03 Feb 2023 05:26:17 -0500 Subject: [Git][ghc/ghc][master] gitlab-ci: Eliminate redundant ghc --info output Message-ID: <63dce149d5152_1108fe5260c49519d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - 1 changed file: - .gitlab/ci.sh Changes: ===================================== .gitlab/ci.sh ===================================== @@ -214,8 +214,6 @@ function set_toolchain_paths() { cat toolchain.sh fi source toolchain.sh - info "--info for GHC for $NIX_SYSTEM" - $GHC --info ;; env) # These are generally set by the Docker image but @@ -274,6 +272,11 @@ function setup() { show_tool CABAL show_tool HAPPY show_tool ALEX + + info "=====================================================" + info "ghc --info" + info "=====================================================" + $GHC --info } function fetch_ghc() { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8feb93013cf6f093e025c9e9a3213ae1fa0f73a0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8feb93013cf6f093e025c9e9a3213ae1fa0f73a0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 10:37:35 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Fri, 03 Feb 2023 05:37:35 -0500 Subject: [Git][ghc/ghc][wip/int-index/decl-invis-binders] Comments and error messages Message-ID: <63dce3efa4aec_1108fedca32a04999e6@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/decl-invis-binders at Glasgow Haskell Compiler / GHC Commits: 99821af2 by Vladislav Zavialov at 2023-02-03T13:37:26+03:00 Comments and error messages - - - - - 6 changed files: - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/TyCl.hs - testsuite/tests/th/T12045TH2.hs - testsuite/tests/typecheck/should_fail/T22560_fail_a.stderr - testsuite/tests/typecheck/should_fail/T22560_fail_b.stderr - testsuite/tests/typecheck/should_fail/T22560_fail_d.stderr Changes: ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1314,17 +1314,21 @@ instance Diagnostic TcRnMessage where TcRnInvalidInvisTyVarBndr name hs_bndr -> mkSimpleDecorated $ - vcat [ text "Invalid invisible type variable binder:" - , nest 2 (ppr hs_bndr) + vcat [ hang (text "Invalid invisible type variable binder:") + 2 (ppr hs_bndr) , text "There is no matching forall-bound variable" - , text "in the standalone kind signature for" <+> quotes (ppr name) <> dot ] + , text "in the standalone kind signature for" <+> quotes (ppr name) <> dot + , text "NB." <+> vcat [ + text "Only" <+> quotes (text "forall a.") <+> text "-quantification matches invisible binders,", + text "whereas" <+> quotes (text "forall {a}.") <+> text "and" <+> quotes (text "forall a ->") <+> text "do not." + ]] TcRnInvisBndrWithoutSig _ hs_bndr -> mkSimpleDecorated $ - vcat [ text "Invalid invisible type variable binder:" - , nest 2 (ppr hs_bndr) + vcat [ hang (text "Invalid invisible type variable binder:") + 2 (ppr hs_bndr) , text "Either a standalone kind signature (SAKS)" - , nest 2 (text "or a complete user-supplied kind (CUSK)") + , text "or a complete user-supplied kind (CUSK, legacy feature)" , text "is required to use invisible binders." ] diagnosticReason = \case ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -352,7 +352,7 @@ Note [TcTyCon, MonoTcTyCon, and PolyTcTyCon] A TcTyCon is one of the variants of TyCon. First, here are its invariants: * TcTyCon: a TyCon built with the TcTyCon constructor - A TcTyCon contain TcTyVars in its binders and kind + A TcTyCon contains TcTyVars in its binders and kind * TcTyConBinder: a TyConBinder with a TcTyVar inside (not a TyVar) @@ -448,7 +448,7 @@ S3) Still in kcTyClGroup, we use generaliseTyClDecl to generalize each MonoTcTyCon to get a PolyTcTyCon, with skolem TcTyVars in it, and a final, fixed kind. -S4) Finally, back in TcTyClDecls, we extend the environment with +S4) Finally, back in tcTyClDecls, we extend the environment with the PolyTcTyCons, and typecheck each declaration (regardless of kind signatures etc) to get final TyCon. @@ -539,11 +539,14 @@ But notice that (#16344 comment:3) * The algorithm successfully kind-checks this declaration: data T2 ka (a::ka) = MkT2 (T2 Type a) - Starting with (inferInitialKinds) - T2 :: (kappa1 :: kappa2 :: *) -> (kappa3 :: kappa4 :: *) -> * - we get - kappa4 := kappa1 -- from the (a:ka) kind signature - kappa1 := Type -- From application T2 Type + Starting with inferInitialKinds: + MonoTcTyCon binders: + ka[tyv] :: (kappa1[tau] :: Type) + ia[tyv] :: (ka[tyv] :: Type) + MonoTcTyCon kind: + T2 :: kappa1[tau] -> ka[tyv] -> Type + From (ka :: kappa1) and (ka :: Type) we learned that + kappa1 := Type These constraints are soluble so generaliseTcTyCon gives T2 :: forall (k::Type) -> k -> * ===================================== testsuite/tests/th/T12045TH2.hs ===================================== @@ -1,6 +1,6 @@ {-# LANGUAGE Haskell2010 #-} -{-# LANGUAGE TemplateHaskell, TypeApplications, TypeAbstractions, - PolyKinds, TypeFamilies, DataKinds #-} +{-# LANGUAGE TemplateHaskell, TypeApplications, PolyKinds + , TypeFamilies, DataKinds #-} module T12045TH2 where ===================================== testsuite/tests/typecheck/should_fail/T22560_fail_a.stderr ===================================== @@ -1,7 +1,8 @@ T22560_fail_a.hs:7:1: error: [GHC-57916] - • Invalid invisible type variable binder: - @k + • Invalid invisible type variable binder: @k There is no matching forall-bound variable in the standalone kind signature for ‘P’. + NB. Only ‘forall a.’ -quantification matches invisible binders, + whereas ‘forall {a}.’ and ‘forall a ->’ do not. • In the data type declaration for ‘P’ ===================================== testsuite/tests/typecheck/should_fail/T22560_fail_b.stderr ===================================== @@ -1,7 +1,8 @@ T22560_fail_b.hs:6:1: error: [GHC-57916] - • Invalid invisible type variable binder: - @a + • Invalid invisible type variable binder: @a There is no matching forall-bound variable in the standalone kind signature for ‘P’. + NB. Only ‘forall a.’ -quantification matches invisible binders, + whereas ‘forall {a}.’ and ‘forall a ->’ do not. • In the data type declaration for ‘P’ ===================================== testsuite/tests/typecheck/should_fail/T22560_fail_d.stderr ===================================== @@ -1,9 +1,8 @@ T22560_fail_d.hs:5:1: error: [GHC-92337] - • Invalid invisible type variable binder: - @k + • Invalid invisible type variable binder: @k Either a standalone kind signature (SAKS) - or a complete user-supplied kind (CUSK) + or a complete user-supplied kind (CUSK, legacy feature) is required to use invisible binders. • In the data type declaration for ‘T’ Suggested fix: Add a standalone kind signature for ‘T’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/99821af2d9bb747adce207357c10f0989ecbe575 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/99821af2d9bb747adce207357c10f0989ecbe575 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 10:51:06 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Fri, 03 Feb 2023 05:51:06 -0500 Subject: [Git][ghc/ghc][wip/int-index/decl-invis-binders] Fix typo Message-ID: <63dce71a22263_1108fe52634509274@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/decl-invis-binders at Glasgow Haskell Compiler / GHC Commits: 9cc8cf7d by Vladislav Zavialov at 2023-02-03T13:50:59+03:00 Fix typo - - - - - 1 changed file: - compiler/GHC/Tc/TyCl.hs Changes: ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -542,7 +542,7 @@ But notice that (#16344 comment:3) Starting with inferInitialKinds: MonoTcTyCon binders: ka[tyv] :: (kappa1[tau] :: Type) - ia[tyv] :: (ka[tyv] :: Type) + a[tyv] :: (ka[tyv] :: Type) MonoTcTyCon kind: T2 :: kappa1[tau] -> ka[tyv] -> Type From (ka :: kappa1) and (ka :: Type) we learned that View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9cc8cf7dcf92dd0ec65b2b4116c9bc9416fc6c29 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9cc8cf7dcf92dd0ec65b2b4116c9bc9416fc6c29 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 10:56:56 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 03 Feb 2023 05:56:56 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 10 commits: Enable tables next to code for LoongArch64 Message-ID: <63dce8786a19b_1108fe5265c51294@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - a36c3e8c by Ryan Scott at 2023-02-03T05:56:45-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 88850e94 by Tamar Christina at 2023-02-03T05:56:45-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - c5e309f7 by Ben Gamari at 2023-02-03T05:56:45-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - a49a9029 by Andreas Klebinger at 2023-02-03T05:56:47-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - 97b12e8f by Ben Gamari at 2023-02-03T05:56:48-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToLlvm/Mangler.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Types/CostCentre.hs - compiler/ghc.cabal.in - configure.ac - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Packages.hs - libraries/base/GHC/IO/Handle/Types.hs - libraries/base/System/Posix/Internals.hs - libraries/base/base.cabal - libraries/base/configure.ac - libraries/base/include/HsBase.h - libraries/containers - libraries/ghc-prim/ghc-prim.cabal - libraries/ghci/GHCi/InfoTable.hsc - m4/ghc_tables_next_to_code.m4 - mk/get-win32-tarballs.py - rts/Linker.c - rts/LinkerInternals.h The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/853350f58677a57e367d16a16cb0031986b5d7ec...97b12e8f9bb877b0d3f5790d353767474b3b2073 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/853350f58677a57e367d16a16cb0031986b5d7ec...97b12e8f9bb877b0d3f5790d353767474b3b2073 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 11:45:38 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Fri, 03 Feb 2023 06:45:38 -0500 Subject: [Git][ghc/ghc][wip/T22740] Once more Message-ID: <63dcf3e214913_1108fe12881c08527348@gitlab.mail> Sylvain Henry pushed to branch wip/T22740 at Glasgow Haskell Compiler / GHC Commits: 7e318b44 by Sylvain Henry at 2023-02-03T12:50:00+01:00 Once more - - - - - 1 changed file: - testsuite/tests/rts/all.T Changes: ===================================== testsuite/tests/rts/all.T ===================================== @@ -42,7 +42,7 @@ test('derefnull', when(platform('aarch64-apple-darwin'), [ignore_stderr, exit_code(139)]), when(opsys('mingw32'), [ignore_stderr, exit_code(11)]), when(opsys('mingw32'), [fragile(18548)]), - when(platform('js-unknown-ghcjs'), [ignore_stderr, exit_code(1)]), + when(arch('javascript'), [ignore_stderr, exit_code(1)]), # ThreadSanitizer changes the output when(have_thread_sanitizer(), skip), # since these test are supposed to crash the View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e318b44d07d21ee19e104d9f516726b33c7706d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e318b44d07d21ee19e104d9f516726b33c7706d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 12:29:39 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Fri, 03 Feb 2023 07:29:39 -0500 Subject: [Git][ghc/ghc][wip/9.2.6-backports] 17 commits: Fix #22728: Not all diagnostics in safe check are fatal Message-ID: <63dcfe339f99f_1108fe5265c54033b@gitlab.mail> Zubin pushed to branch wip/9.2.6-backports at Glasgow Haskell Compiler / GHC Commits: 77b2b8e1 by Oleg Grenrus at 2023-02-03T17:58:36+05:30 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general (cherry picked from commit 1b812b6973a25cb1962e2fc543d2c4ed3cf31f3c) - - - - - 220a92d7 by Zubin Duggal at 2023-02-03T17:58:36+05:30 Document #22255 and #22468 in bugs.rst - - - - - 68151345 by Simon Peyton Jones at 2023-02-03T17:58:36+05:30 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 (cherry picked from commit 3d55d8ab51ece43c51055c43c9e7aba77cce46c0) - - - - - 1eb3a0d0 by Simon Peyton Jones at 2023-02-03T17:58:36+05:30 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. (cherry picked from commit e193e53790dd5886feea3cf4c9c17625d188291b) - - - - - 09345ef2 by Sebastian Graf at 2023-02-03T17:58:36+05:30 DmdAnal: Don't panic in addCaseBndrDmd (#22039) Rather conservatively return Top. See Note [Untyped demand on case-alternative binders]. I also factored `addCaseBndrDmd` into two separate functions `scrutSubDmd` and `fieldBndrDmds`. Fixes #22039. (cherry picked from commit d2be80fd9b222963e8dd09a30f78c106e00da7f9) - - - - - ebe750de by Matthew Pickering at 2023-02-03T17:58:36+05:30 ApplicativeDo: Set pattern location before running exhaustiveness checker This improves the error messages of the exhaustiveness checker when checking statements which have been moved around with ApplicativeDo. Before: Test.hs:2:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 2 | let x = () | ^^^^^^^^^^ After: Test.hs:4:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 4 | ~(Just res1) <- seq x (pure $ Nothing @()) | Fixes #22483 (cherry picked from commit 74c767df770766d8d52e87b9ff7da10f94620a91) (cherry picked from commit 51c6051bcc405bc1dbddd450ade949acd70db6b8) - - - - - cd26f1cf by Andreas Klebinger at 2023-02-03T17:58:36+05:30 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- (cherry picked from commit 08ba87200ff068aa37cac082e61ee7e2d534daf5) - - - - - 2d14b37f by Matthew Pickering at 2023-02-03T17:58:36+05:30 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s (cherry picked from commit a960ca817d6ad0109ea6edda50da3902cc538e86) - - - - - 126c48f7 by Matthew Pickering at 2023-02-03T17:58:36+05:30 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. (cherry picked from commit 734847108420cf826a807c30ad54651659cf3a08) - - - - - 8bc4b443 by Matthew Pickering at 2023-02-03T17:58:36+05:30 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes (cherry picked from commit 8c0ea25fb4a27d4729aabf73f4c00b912bb0c58d) - - - - - 63538c88 by Cheng Shao at 2023-02-03T17:58:36+05:30 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. (cherry picked from commit c45a5fffef2c76efbf5d3a009c3f6d0244a63f0d) - - - - - fe470814 by Ben Gamari at 2023-02-03T17:58:36+05:30 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. (cherry picked from commit be417a47c7695998dea0adc05489a7b8838a78b6) - - - - - e8ecb0b4 by Ben Gamari at 2023-02-03T17:58:36+05:30 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. (cherry picked from commit 30989d137b8f3a8fddbfd116e04b48f23c24f86c) - - - - - 01efc715 by Ben Gamari at 2023-02-03T17:58:36+05:30 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. (cherry picked from commit 7566fd9de38c67360c090f828923d41587af519c) - - - - - 9dee4baa by Ben Gamari at 2023-02-03T17:58:36+05:30 testsuite: Add regression test for #22798 (cherry picked from commit 2cb500a5ee1a31dfe1a2cdd71f175442026eb082) - - - - - 5308d7bf by Zubin Duggal at 2023-02-03T17:58:36+05:30 hadrian: enable -haddock in perf flavour (#22734) - - - - - fff390ab by Zubin Duggal at 2023-02-03T17:58:36+05:30 Testsuite fixes - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/HsToCore/Expr.hs - compiler/cbits/keepCAFsForGHCi.c - compiler/ghc.mk - configure.ac - docs/users_guide/bugs.rst - hadrian/src/Settings/Flavours/Performance.hs - + m4/fp_ld_no_fixup_chains.m4 - + testsuite/tests/ado/T22483.hs - + testsuite/tests/ado/T22483.stderr - testsuite/tests/ado/all.T - + testsuite/tests/codeGen/should_run/T22798.hs - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/ghci/T16392/T16392.script - testsuite/tests/ghci/linking/dyn/Makefile - testsuite/tests/ghci/scripts/T9881.stdout - testsuite/tests/ghci/scripts/ghci025.stdout - testsuite/tests/rts/T18623/all.T - + testsuite/tests/safeHaskell/warnings/Makefile - + testsuite/tests/safeHaskell/warnings/T22728.hs - + testsuite/tests/safeHaskell/warnings/T22728.stderr - + testsuite/tests/safeHaskell/warnings/T22728_B.hs - + testsuite/tests/safeHaskell/warnings/T22728b.hs - + testsuite/tests/safeHaskell/warnings/T22728b.stderr - + testsuite/tests/safeHaskell/warnings/T22728b_B.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/94dad10d174909118bfd210b71d808f9e99f6d31...fff390abd7e927dfaf64d75c8b323704a99e016a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/94dad10d174909118bfd210b71d808f9e99f6d31...fff390abd7e927dfaf64d75c8b323704a99e016a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 12:45:29 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 03 Feb 2023 07:45:29 -0500 Subject: [Git][ghc/ghc][wip/int-index/decl-invis-binders] Wibble comments Message-ID: <63dd01e98c07_1108fe52648544518@gitlab.mail> Simon Peyton Jones pushed to branch wip/int-index/decl-invis-binders at Glasgow Haskell Compiler / GHC Commits: ee0cc50d by Simon Peyton Jones at 2023-02-03T12:46:02+00:00 Wibble comments - - - - - 2 changed files: - compiler/GHC/Hs/Type.hs - compiler/GHC/Tc/TyCl.hs Changes: ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -286,6 +286,8 @@ type instance XXTyVarBndr (GhcPass _) = DataConCantHappen hsTyVarBndrFlag :: HsTyVarBndr flag (GhcPass pass) -> flag hsTyVarBndrFlag (UserTyVar _ fl _) = fl hsTyVarBndrFlag (KindedTyVar _ fl _ _) = fl +-- By specialising to (GhcPass p) we know that XXTyVarBndr is DataConCantHappen +-- so these two equations are exhaustive: extension construction can't happen -- | Set the attached flag setHsTyVarBndrFlag :: flag -> HsTyVarBndr flag' (GhcPass pass) ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -412,16 +412,22 @@ come upon knowledge of the eventual tycon in bits and pieces, and we use a TcTyCon to record what we know before we are ready to build the final TyCon. Here is the plan: -* Step 1 (inferInitialKinds, inference only, skipped for checking): +* Step 1 (inferInitialKinds, called from kcTyClGroup + inference only, skipped for checking): Make a MonoTcTyCon whose binders are TcTyVars, that may contain free unification variables. See Note [No polymorphic recursion in type decls] -* Step 2 (generaliseTcTyCon) +* Step 2 (kcTyClDecl, called from kcTyClGroup) + Kind-check the declarations of the group; this step just does + unifications that affect the unification variables created in + Step 1 + +* Step 3 (generaliseTcTyCon, called from kcTyClGroup) Generalise that MonoTcTyCon to make a PolyTcTyCon Its binders are skolem TcTyVars, with accurate SkolemInfo -* Step 3 (tcTyClDecl) +* Step 4 (tcTyClDecl, called from tcTyClDecls) Typecheck the type and class decls to produce a final TyCon Its binders are final TyVars, not TcTyVars @@ -504,7 +510,7 @@ Note [No polymorphic recursion in type decls] In GHC.Tc.HsType.kcInferDeclHeader we use mkAnonTyConBinders to make the TyConBinders for the MonoTcTyCon. Here is why. -Should this kind-check? +Should this kind-check (cf #16344)? data T ka (a::ka) b = MkT (T Type Int Bool) (T (Type -> Type) Maybe Bool) @@ -536,26 +542,29 @@ all arguments when figuring out tc_binders. But notice that (#16344 comment:3) -* The algorithm successfully kind-checks this declaration: +* Consider this declaration: data T2 ka (a::ka) = MkT2 (T2 Type a) - Starting with inferInitialKinds: + Starting with inferInitialKinds + (Step 1 of Note [TcTyCon, MonoTcTyCon, and PolyTcTyCon]): MonoTcTyCon binders: ka[tyv] :: (kappa1[tau] :: Type) a[tyv] :: (ka[tyv] :: Type) MonoTcTyCon kind: T2 :: kappa1[tau] -> ka[tyv] -> Type - From (ka :: kappa1) and (ka :: Type) we learned that - kappa1 := Type - These constraints are soluble so generaliseTcTyCon gives + Given this kind for T2, in Step 2 we kind-check (T2 Type a) + from where we see + T2's first arg: (kappa1 ~ Type) + T2's second arg: (ka ~ ka) + These constraints are soluble by (kappa1 := Type) + so generaliseTcTyCon (Step 3) gives T2 :: forall (k::Type) -> k -> * - But now the /typechecking/ (aka desugaring, tcTyClDecl) phase - fails, because the call (T2 Type a) in the RHS is ill-kinded. + But now the /typechecking/ (Step 4, aka desugaring, tcTyClDecl) + phase fails, because the call (T2 Type a) in the RHS is ill-kinded. - We'd really prefer all errors to show up in the kind checking - phase. + We'd really prefer all errors to show up in the kind checking phase. * This algorithm still accepts (in all phases) data T3 ka (a::ka) = forall b. MkT3 (T3 Type b) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0cc50d6ae34ed1a7bae640cf04a218ab9b0c68 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0cc50d6ae34ed1a7bae640cf04a218ab9b0c68 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 13:09:33 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Fri, 03 Feb 2023 08:09:33 -0500 Subject: [Git][ghc/ghc][wip/js-th] Fix some tests Message-ID: <63dd078d5f1bb_1108fe52634580774@gitlab.mail> Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC Commits: 770d2849 by Sylvain Henry at 2023-02-03T14:13:47+01:00 Fix some tests - - - - - 25 changed files: - libraries/template-haskell/tests/all.T - testsuite/driver/testlib.py - testsuite/tests/annotations/should_compile/all.T - testsuite/tests/annotations/should_fail/all.T - testsuite/tests/driver/all.T - testsuite/tests/driver/fat-iface/all.T - testsuite/tests/layout/all.T - testsuite/tests/overloadedrecflds/should_compile/all.T - testsuite/tests/partial-sigs/should_compile/all.T - testsuite/tests/partial-sigs/should_fail/all.T - testsuite/tests/printer/all.T - testsuite/tests/quasiquotation/all.T - testsuite/tests/quasiquotation/qq001/test.T - testsuite/tests/quasiquotation/qq002/test.T - testsuite/tests/quasiquotation/qq003/test.T - testsuite/tests/quasiquotation/qq004/test.T - testsuite/tests/quasiquotation/qq009/test.T - testsuite/tests/safeHaskell/safeLanguage/all.T - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/th/T2014/all.T - testsuite/tests/th/all.T - testsuite/tests/th/overloaded/all.T - testsuite/tests/th/should_compile/T13949/all.T - testsuite/tests/th/should_compile/T8025/all.T - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== libraries/template-haskell/tests/all.T ===================================== @@ -1,3 +1,3 @@ # difficult to test TH with profiling, because we have to build twice -test('dataToExpQUnit', [omit_ways(prof_ways), req_interp], compile, ['-v0']) -test('pragCompletePpr', [omit_ways(prof_ways), req_interp], compile_and_run, ['']) +test('dataToExpQUnit', [omit_ways(prof_ways), req_th], compile, ['-v0']) +test('pragCompletePpr', [omit_ways(prof_ways), req_th], compile_and_run, ['']) ===================================== testsuite/driver/testlib.py ===================================== @@ -243,6 +243,10 @@ def req_profiling( name, opts ): if not config.have_profiling: opts.expect = 'fail' + # JS backend doesn't support profiling yet + if arch("js"): + opts.expect = 'fail' + def req_dynamic_lib_support( name, opts ): ''' Require that the platform have shared object support (N.B. this doesn't @@ -263,6 +267,18 @@ def req_interp( name, opts ): if not config.have_interp: opts.expect = 'fail' +def req_bco( name, opts ): + ''' + Require support for ByteCode + ''' + + # Requires the interpreter + req_interp + + # JS backend doesn't support ByteCode either + if arch("js"): + opts.expect = 'fail' + def req_rts_linker( name, opts ): if not config.have_RTS_linker: opts.expect = 'fail' ===================================== testsuite/tests/annotations/should_compile/all.T ===================================== @@ -2,9 +2,9 @@ # order for this to work with profiling, we would have to build the # program twice and use -osuf p_o (see the TH_spliceE5_prof test). For # now, just disable the profiling ways. -test('ann01', [req_interp, omit_ways(prof_ways)], compile, ['-v0']) -test('T14129', [req_interp, omit_ways(prof_ways)], compile, ['-v0']) -test('T19374a', [req_interp, omit_ways(prof_ways)], compile, ['-v0']) +test('ann01', [req_th, omit_ways(prof_ways)], compile, ['-v0']) +test('T14129', [req_th, omit_ways(prof_ways)], compile, ['-v0']) +test('T19374a', [req_th, omit_ways(prof_ways)], compile, ['-v0']) """" Helpful things to C+P: ===================================== testsuite/tests/annotations/should_fail/all.T ===================================== @@ -1,23 +1,23 @@ -test('annfail01', req_interp, compile_fail, ['']) -test('annfail02', req_interp, compile_fail, ['']) -test('annfail03', req_interp, compile_fail, ['']) +test('annfail01', req_th, compile_fail, ['']) +test('annfail02', req_th, compile_fail, ['']) +test('annfail03', req_th, compile_fail, ['']) test('annfail04', [extra_files(['Annfail04_Help.hs']), - req_interp], multimod_compile_fail, ['annfail04', '-v0']) + req_th], multimod_compile_fail, ['annfail04', '-v0']) test('annfail05', [extra_files(['Annfail05_Help.hs']), - req_interp], multimod_compile_fail, ['annfail05', '-v0']) + req_th], multimod_compile_fail, ['annfail05', '-v0']) test('annfail06', [extra_files(['Annfail06_Help.hs']), - req_interp], multimod_compile_fail, ['annfail06', '-v0']) -test('annfail07', req_interp, compile_fail, ['']) -test('annfail08', req_interp, compile_fail, ['']) -test('annfail09', req_interp, compile_fail, ['']) -test('annfail10', req_interp, compile_fail, ['']) -test('annfail11', req_interp, compile_fail, ['']) -test('annfail12', req_interp, compile_fail, ['-v0']) -test('annfail13', req_interp, compile_fail, ['']) -test('T10826', req_interp, compile_fail, ['']) -test('T19374b', req_interp, compile_fail, ['']) -test('T19374c', req_interp, compile_fail, ['']) + req_th], multimod_compile_fail, ['annfail06', '-v0']) +test('annfail07', req_th, compile_fail, ['']) +test('annfail08', req_th, compile_fail, ['']) +test('annfail09', req_th, compile_fail, ['']) +test('annfail10', req_th, compile_fail, ['']) +test('annfail11', req_th, compile_fail, ['']) +test('annfail12', req_th, compile_fail, ['-v0']) +test('annfail13', req_th, compile_fail, ['']) +test('T10826', req_th, compile_fail, ['']) +test('T19374b', req_th, compile_fail, ['']) +test('T19374c', req_th, compile_fail, ['']) """" Helpful things to C+P: ===================================== testsuite/tests/driver/all.T ===================================== @@ -288,6 +288,7 @@ test('T15396', normal, compile_and_run, ['-package ghc']) test('T16737', [extra_files(['T16737include/']), req_th, + req_c, expect_broken_for(16541, ['ghci'])], compile_and_run, ['-optP=-isystem -optP=T16737include']) ===================================== testsuite/tests/driver/fat-iface/all.T ===================================== @@ -1,17 +1,17 @@ test('fat001', [extra_files(['Fat.hs'])], makefile_test, ['fat001']) -test('fat005', [extra_files(['Fat.hs']), filter_stdout_lines(r'= Proto-BCOs'), js_broken(22261)], makefile_test, ['fat005']) +test('fat005', [extra_files(['Fat.hs']), filter_stdout_lines(r'= Proto-BCOs')], makefile_test, ['fat005']) test('fat006', [extra_files(['Fat.hs'])], makefile_test, ['fat006']) test('fat006a', [extra_files(['Fat.hs'])], makefile_test, ['fat006a']) test('fat007', [extra_files(['Fat.hs'])], makefile_test, ['fat007']) test('fat008', [req_th, unless(ghc_dynamic(), skip), extra_files(['FatTH.hs', 'FatQuote.hs']), copy_files], makefile_test, ['fat008']) -test('fat009', [req_th, extra_files(['FatTH.hs', 'FatQuote.hs']), copy_files], makefile_test, ['fat009']) +test('fat009', [req_interp, extra_files(['FatTH.hs', 'FatQuote.hs']), copy_files], makefile_test, ['fat009']) test('fat010', [req_th,extra_files(['THA.hs', 'THB.hs', 'THC.hs']), copy_files], makefile_test, ['fat010']) # Check linking works when using -fbyte-code-and-object-code test('fat011', [req_th, extra_files(['FatMain.hs', 'FatTH.hs', 'FatQuote.hs'])], multimod_compile, ['FatMain', '-fbyte-code-and-object-code -fprefer-byte-code']) # Check that we use interpreter rather than enable dynamic-too if needed for TH test('fat012', [req_th, unless(ghc_dynamic(), skip), extra_files(['FatTH.hs', 'FatQuote.hs'])], multimod_compile, ['FatTH', '-fprefer-byte-code']) # Check that no objects are generated if using -fno-code and -fprefer-byte-code -test('fat013', [req_th, extra_files(['FatTH.hs', 'FatQuote.hs'])], multimod_compile, ['FatTH', '-fno-code -fprefer-byte-code']) +test('fat013', [req_th, req_bco, extra_files(['FatTH.hs', 'FatQuote.hs'])], multimod_compile, ['FatTH', '-fno-code -fprefer-byte-code']) # When using interpreter should not produce objects test('fat014', [req_th, extra_files(['FatTH.hs', 'FatQuote.hs']), extra_run_opts('-fno-code')], ghci_script, ['fat014.script']) test('fat015', [req_th, unless(ghc_dynamic(), skip), extra_files(['FatQuote.hs', 'FatQuote1.hs', 'FatQuote2.hs', 'FatTH1.hs', 'FatTH2.hs', 'FatTHTop.hs'])], multimod_compile, ['FatTHTop', '-fno-code -fwrite-interface']) ===================================== testsuite/tests/layout/all.T ===================================== @@ -11,7 +11,7 @@ test('layout005', [], makefile_test, ['layout005']) test('layout006', [], makefile_test, ['layout006']) -test('layout007', [req_interp], makefile_test, ['layout007']) +test('layout007', [req_th], makefile_test, ['layout007']) test('layout008', [], makefile_test, ['layout008']) ===================================== testsuite/tests/overloadedrecflds/should_compile/all.T ===================================== @@ -3,7 +3,7 @@ test('T12609', normal, compile, ['']) test('T16597', [], multimod_compile, ['T16597', '-v0']) test('T17176', normal, compile, ['']) test('DRFPatSynExport', [], makefile_test, ['DRFPatSynExport']) -test('NoFieldSelectors', req_interp, compile, ['']) +test('NoFieldSelectors', req_th, compile, ['']) test('NFSDRF', normal, compile, ['']) test('NFSImport', [extra_files(['NFSExport.hs'])], multimod_compile, ['NFSImport NFSExport', '-v0']) test('T18999_NoFieldSelectors', normal, compile, ['']) ===================================== testsuite/tests/partial-sigs/should_compile/all.T ===================================== @@ -49,7 +49,7 @@ test('PatternSig', normal, compile, ['-ddump-types -fno-warn-partial-type-signat # (1) Use -fexternal-interpreter, or # (2) Build the program twice: once with -dynamic, and then # with -prof using -osuf to set a different object file suffix. -test('PatternSplice', [req_interp, omit_ways(['profasm'])], compile, ['-fno-warn-partial-type-signatures']) +test('PatternSplice', [req_th, omit_ways(['profasm'])], compile, ['-fno-warn-partial-type-signatures']) test('Recursive', normal, compile, ['-ddump-types -fno-warn-partial-type-signatures']) test('ScopedNamedWildcards', normal, compile, ['-ddump-types -fno-warn-partial-type-signatures']) test('ScopedNamedWildcardsGood', normal, compile, ['-ddump-types -fno-warn-partial-type-signatures']) ===================================== testsuite/tests/partial-sigs/should_fail/all.T ===================================== @@ -3,9 +3,9 @@ test('AnnotatedConstraintNotForgotten', normal, compile_fail, ['']) test('Defaulting1MROff', normal, compile, ['']) test('ExtraConstraintsWildcardInExpressionSignature', normal, compile, ['']) test('ExtraConstraintsWildcardInPatternSignature', normal, compile_fail, ['']) -test('ExtraConstraintsWildcardInPatternSplice', [req_interp, normal], compile_fail, ['']) +test('ExtraConstraintsWildcardInPatternSplice', [req_th, normal], compile_fail, ['']) test('ExtraConstraintsWildcardInTypeSpliceUsed', [extra_files(['ExtraConstraintsWildcardInTypeSplice.hs']), - req_interp], + req_th], multimod_compile_fail, ['ExtraConstraintsWildcardInTypeSpliceUsed', config.ghc_th_way_flags]) test('ExtraConstraintsWildcardInTypeSplice2', ===================================== testsuite/tests/printer/all.T ===================================== @@ -31,7 +31,7 @@ test('Ppr023', [ignore_stderr, req_ppr_deps], makefile_test, ['ppr023']) test('Ppr024', [ignore_stderr, req_ppr_deps], makefile_test, ['ppr024']) test('Ppr025', [ignore_stderr, req_ppr_deps], makefile_test, ['ppr025']) test('Ppr026', [ignore_stderr, req_ppr_deps], makefile_test, ['ppr026']) -test('Ppr027', [ignore_stderr, req_interp,req_ppr_deps], makefile_test, ['ppr027']) +test('Ppr027', [ignore_stderr, req_th,req_ppr_deps], makefile_test, ['ppr027']) test('Ppr028', [ignore_stderr, req_ppr_deps], makefile_test, ['ppr028']) test('Ppr029', [ignore_stderr, req_ppr_deps], makefile_test, ['ppr029']) test('Ppr030', [ignore_stderr, req_ppr_deps], makefile_test, ['ppr030']) @@ -44,10 +44,10 @@ test('Ppr036', [ignore_stderr, req_ppr_deps], makefile_test, ['ppr036']) test('Ppr037', [ignore_stderr, req_ppr_deps], makefile_test, ['ppr037']) test('Ppr038', [ignore_stderr, req_ppr_deps], makefile_test, ['ppr038']) test('Ppr039', [ignore_stderr, req_ppr_deps], makefile_test, ['ppr039']) -test('Ppr040', [ignore_stderr, req_interp,req_ppr_deps], makefile_test, ['ppr040']) +test('Ppr040', [ignore_stderr, req_th,req_ppr_deps], makefile_test, ['ppr040']) test('Ppr041', [ignore_stderr, req_ppr_deps], makefile_test, ['ppr041']) test('Ppr042', [ignore_stderr, req_ppr_deps], makefile_test, ['ppr042']) -test('Ppr043', [ignore_stderr, req_interp,req_ppr_deps], makefile_test, ['ppr043']) +test('Ppr043', [ignore_stderr, req_th,req_ppr_deps], makefile_test, ['ppr043']) test('Ppr044', [ignore_stderr, req_ppr_deps], makefile_test, ['ppr044']) test('Ppr045', [ignore_stderr, req_ppr_deps], makefile_test, ['ppr045']) test('Ppr046', [ignore_stderr, req_ppr_deps], makefile_test, ['ppr046']) @@ -60,12 +60,12 @@ test('Ppr053', [ignore_stderr, req_ppr_deps], makefile_test, ['ppr053']) test('Ppr054', [ignore_stderr, req_ppr_deps], makefile_test, ['ppr054']) test('Ppr055', [ignore_stderr, req_ppr_deps], makefile_test, ['ppr055']) test('T13050p', [ignore_stderr, req_ppr_deps], makefile_test, ['T13050p']) -test('T13199', [ignore_stderr, req_interp,req_ppr_deps], makefile_test, ['T13199']) -test('T13550', [ignore_stderr, req_interp,req_ppr_deps], makefile_test, ['T13550']) -test('T13942', [ignore_stderr, req_interp,req_ppr_deps], makefile_test, ['T13942']) -test('T14289', [ignore_stderr, req_interp,req_ppr_deps], makefile_test, ['T14289']) -test('T14289b', [ignore_stderr, req_interp,req_ppr_deps], makefile_test, ['T14289b']) -test('T14289c', [ignore_stderr, req_interp,req_ppr_deps], makefile_test, ['T14289c']) +test('T13199', [ignore_stderr, req_th,req_ppr_deps], makefile_test, ['T13199']) +test('T13550', [ignore_stderr, req_th,req_ppr_deps], makefile_test, ['T13550']) +test('T13942', [ignore_stderr, req_th,req_ppr_deps], makefile_test, ['T13942']) +test('T14289', [ignore_stderr, req_th,req_ppr_deps], makefile_test, ['T14289']) +test('T14289b', [ignore_stderr, req_th,req_ppr_deps], makefile_test, ['T14289b']) +test('T14289c', [ignore_stderr, req_th,req_ppr_deps], makefile_test, ['T14289c']) test('T14306', [ignore_stderr, req_ppr_deps], makefile_test, ['T14306']) test('T14343', normal, compile_fail, ['']) test('T14343b', normal, compile_fail, ['']) ===================================== testsuite/tests/quasiquotation/all.T ===================================== @@ -1,6 +1,6 @@ -test('T3953', req_interp, compile_fail, ['']) +test('T3953', req_th, compile_fail, ['']) test('T4150', [expect_broken(4150)], makefile_test, ['T4150']) -test('T5204', req_interp, compile_fail, ['']) +test('T5204', req_th, compile_fail, ['']) test('T7918', [req_interp, extra_run_opts('"' + config.libdir + '"'), only_ways([config.ghc_th_way]), unless(have_dynamic(), skip)], ===================================== testsuite/tests/quasiquotation/qq001/test.T ===================================== @@ -1 +1 @@ -test('qq001', req_interp, compile_fail, ['']) +test('qq001', req_th, compile_fail, ['']) ===================================== testsuite/tests/quasiquotation/qq002/test.T ===================================== @@ -1 +1 @@ -test('qq002', req_interp, compile_fail, ['']) +test('qq002', req_th, compile_fail, ['']) ===================================== testsuite/tests/quasiquotation/qq003/test.T ===================================== @@ -1 +1 @@ -test('qq003', req_interp, compile_fail, ['']) +test('qq003', req_th, compile_fail, ['']) ===================================== testsuite/tests/quasiquotation/qq004/test.T ===================================== @@ -1 +1 @@ -test('qq004', req_interp, compile_fail, ['']) +test('qq004', req_th, compile_fail, ['']) ===================================== testsuite/tests/quasiquotation/qq009/test.T ===================================== @@ -2,5 +2,5 @@ test('qq009', [extra_files(['QQ.hs', 'Test.hs']), when(fast(), skip), pre_cmd('$MAKE -s --no-print-directory TH_QQ'), omit_ways(prof_ways), - req_interp], + req_th], multimod_compile, ['Test', '-v0 ' + config.ghc_th_way_flags]) ===================================== testsuite/tests/safeHaskell/safeLanguage/all.T ===================================== @@ -23,7 +23,7 @@ test('SafeLang07', normal, compile_fail, ['']) test('SafeLang08', normal, compile_fail, ['']) test('SafeLang09', [exit_code(1)], compile_and_run, ['']) test('SafeLang10', [], multimod_compile_fail, ['SafeLang10', '']) -test('SafeLang11', [req_interp], multimod_compile_and_run, +test('SafeLang11', [req_th], multimod_compile_and_run, ['SafeLang11', config.ghc_th_way_flags]) test('SafeLang12', normal, multimod_compile_fail, ['SafeLang12', '']) test('SafeLang15', [exit_code(1)], multimod_compile_and_run, ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -134,7 +134,7 @@ test('T5366', normal, makefile_test, ['T5366']) test('T7796', [], makefile_test, ['T7796']) -test('T5550', req_interp, compile, ['']) +test('T5550', req_th, compile, ['']) test('T7865', normal, makefile_test, ['T7865']) # T7785: we want to check that we specialise 'shared'. But Tidy discards the @@ -348,7 +348,7 @@ test('T18747B', normal, compile, ['']) test('T18815', only_ways(['optasm']), makefile_test, ['T18815']) test('T18668', normal, compile, ['-dsuppress-uniques']) test('T18995', [ grep_errmsg(r'print') ], compile, ['-O -ddump-simpl -dsuppress-uniques']) -test('T19168', req_interp, compile, ['']) +test('T19168', req_th, compile, ['']) test('T19246', only_ways(['optasm']), multimod_compile, ['T19246', '-v0 -ddump-rules']) test('T19360', only_ways(['optasm']), compile, ['']) @@ -394,7 +394,7 @@ test('OpaqueNoCastWW', normal, compile, ['-O -ddump-simpl -dsuppress-uniques']) test('OpaqueNoRebox', [ grep_errmsg(r'$wf') ], compile, ['-O -ddump-simpl -dsuppress-uniques']) test('OpaqueNoRebox2', [ grep_errmsg(r'$wf') ], compile, ['-O -ddump-simpl -dsuppress-uniques']) test('OpaqueNoRebox3', [ grep_errmsg(r'$wf') ], compile, ['-O -ddump-simpl -dsuppress-uniques']) -test('OpaqueNoSpecConstr', [ req_interp, grep_errmsg(r'$sloop') ], compile, ['-O -ddump-simpl -dsuppress-uniques']) +test('OpaqueNoSpecConstr', [ req_th, grep_errmsg(r'$sloop') ], compile, ['-O -ddump-simpl -dsuppress-uniques']) test('OpaqueNoSpecialise', [ grep_errmsg(r'$sf') ], compile, ['-O -ddump-simpl -dsuppress-uniques']) test('OpaqueNoStrictArgWW', [ grep_errmsg(r'$wf') ], compile, ['-O -fworker-wrapper-cbv -ddump-simpl -dsuppress-uniques']) test('OpaqueNoWW', [ grep_errmsg(r'$wf') ], compile, ['-O -ddump-simpl -dsuppress-uniques']) ===================================== testsuite/tests/th/T2014/all.T ===================================== @@ -1,3 +1,3 @@ test('T2014', [extra_files(['A.hs', 'A.hs-boot', 'B.hs', 'C.hs']), - req_interp], + req_th], makefile_test, ['T2014']) ===================================== testsuite/tests/th/all.T ===================================== @@ -7,7 +7,8 @@ def f(name, opts): opts.extra_hc_opts = '-XTemplateHaskell -package template-haskell' setTestOpts(f) -setTestOpts(req_interp) +setTestOpts(req_th) + # TH should work with -fexternal-interpreter too if config.have_ext_interp : setTestOpts(extra_ways(['ext-interp'])) ===================================== testsuite/tests/th/overloaded/all.T ===================================== @@ -7,7 +7,7 @@ def f(name, opts): opts.extra_hc_opts = '-XTemplateHaskell -package template-haskell' setTestOpts(f) -setTestOpts(req_interp) +setTestOpts(req_th) # TH should work with -fexternal-interpreter too if config.have_ext_interp : setTestOpts(extra_ways(['ext-interp'])) ===================================== testsuite/tests/th/should_compile/T13949/all.T ===================================== @@ -7,6 +7,6 @@ # (1) Use -fexternal-interpreter, or # (2) Build the program twice: once with -dynamic, and then # with -prof using -osuf to set a different object file suffix. -test('T13949', [extra_files(['ASCII.hs', 'PatternGenerator.hs', 'These.hs', 'Tree.hs']), req_interp, +test('T13949', [extra_files(['ASCII.hs', 'PatternGenerator.hs', 'These.hs', 'Tree.hs']), req_th, omit_ways(['profasm'])], multimod_compile, ['ASCII PatternGenerator These Tree', '-fno-code -v0']) ===================================== testsuite/tests/th/should_compile/T8025/all.T ===================================== @@ -5,5 +5,5 @@ # (1) Use -fexternal-interpreter, or # (2) Build the program twice: once with -dynamic, and then # with -prof using -osuf to set a different object file suffix. -test('T8025', [extra_files(['A.hs', 'B.hs']), omit_ways(['profasm']), req_interp], +test('T8025', [extra_files(['A.hs', 'B.hs']), omit_ways(['profasm']), req_th], multimod_compile, ['A B', '-fno-code -v0']) ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -442,7 +442,7 @@ test('T12837', normal, compile_fail, ['']) test('T12906', normal, compile_fail, ['']) test('T12918a', normal, compile_fail, ['']) test('T12918b', normal, compile_fail, ['']) -test('T12921', req_interp, compile_fail, ['']) +test('T12921', req_th, compile_fail, ['']) test('T12947', normal, compile_fail, ['']) test('StrictBinds', normal, compile_fail, ['']) test('T13068', [extra_files(['T13068.hs', 'T13068a.hs', 'T13068.hs-boot', 'T13068m.hs'])], multimod_compile_fail, ['T13068m', '']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/770d28494203e5ba1c026328723c249346f3237f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/770d28494203e5ba1c026328723c249346f3237f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 13:10:28 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Fri, 03 Feb 2023 08:10:28 -0500 Subject: [Git][ghc/ghc][wip/int-index/decl-invis-binders] 16 commits: Improve treatment of type applications in patterns Message-ID: <63dd07c45f724_1108fe12881c08583490@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/decl-invis-binders at Glasgow Haskell Compiler / GHC Commits: 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - 21cfded1 by Vladislav Zavialov at 2023-02-03T16:09:24+03:00 Invisible binders in type declarations (#22560) This patch implements @k-binders introduced in GHC Proposal #425 and guarded behind the TypeAbstractions extension: type D :: forall k j. k -> j -> Type data D @k @j a b = ... ^^ ^^ To represent the new syntax, we modify LHsQTyVars as follows: - hsq_explicit :: [LHsTyVarBndr () pass] + hsq_explicit :: [LHsTyVarBndr (HsBndrVis pass) pass] HsBndrVis is a new data type that records the distinction between type variable binders written with and without the @ sign: data HsBndrVis pass = HsBndrRequired | HsBndrInvisible (LHsToken "@" pass) The rest of the patch updates GHC, template-haskell, and haddock to handle the new syntax. Parser: The PsErrUnexpectedTypeAppInDecl error message is removed. The syntax it used to reject is now permitted. Renamer: The @ sign does not affect the scope of a binder, so the changes to the renamer are minimal. See rnLHsTyVarBndrVisFlag. Type checker: There are three code paths that were updated to deal with the newly introduced invisible type variable binders: 1. checking SAKS: see kcCheckDeclHeader_sig, matchUpSigWithDecl 2. checking CUSK: see kcCheckDeclHeader_cusk 3. inference: see kcInferDeclHeader, rejectInvisibleBinders Helper functions bindExplicitTKBndrs_Q_Skol and bindExplicitTKBndrs_Q_Tv are generalized to work with HsBndrVis. Updates the haddock submodule. Metric Increase: MultiLayerModulesTH_OneShot Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/CmmToLlvm/Mangler.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Error/Codes.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ee0cc50d6ae34ed1a7bae640cf04a218ab9b0c68...21cfded1b061bb1ad02537de0c8e8681a5c63f43 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ee0cc50d6ae34ed1a7bae640cf04a218ab9b0c68...21cfded1b061bb1ad02537de0c8e8681a5c63f43 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 13:12:17 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Fri, 03 Feb 2023 08:12:17 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/andreask/ww-noinline-dicts Message-ID: <63dd0831856a6_1108fedca32a05843d0@gitlab.mail> Andreas Klebinger pushed new branch wip/andreask/ww-noinline-dicts at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/ww-noinline-dicts You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 13:25:47 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 03 Feb 2023 08:25:47 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/revert-bit-twiddles-master Message-ID: <63dd0b5b9e06c_1108fe193a7398592856@gitlab.mail> Matthew Pickering pushed new branch wip/revert-bit-twiddles-master at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/revert-bit-twiddles-master You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 13:27:15 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 03 Feb 2023 08:27:15 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Windows: Remove mingwex dependency Message-ID: <63dd0bb343065_1108fe526845975cd@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: df04f2ec by Ryan Scott at 2023-02-03T08:27:03-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - d52293c5 by Tamar Christina at 2023-02-03T08:27:03-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - 1b8281db by Ben Gamari at 2023-02-03T08:27:03-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - e231f8f3 by Andreas Klebinger at 2023-02-03T08:27:05-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - 9a29a44b by Ben Gamari at 2023-02-03T08:27:06-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Types/CostCentre.hs - configure.ac - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Packages.hs - libraries/base/System/Posix/Internals.hs - libraries/base/base.cabal - libraries/base/configure.ac - libraries/base/include/HsBase.h - libraries/ghc-prim/ghc-prim.cabal - mk/get-win32-tarballs.py - rts/Linker.c - rts/LinkerInternals.h - rts/RtsSymbols.c - rts/linker/PEi386.c - rts/rts.cabal.in - testsuite/tests/ghci/linking/dyn/Makefile - testsuite/tests/ghci/linking/dyn/all.T - + testsuite/tests/ghci/linking/dyn/bin_impl_gcc/ASimpL.dll - + testsuite/tests/ghci/linking/dyn/bin_impl_gcc/libASx.dll.a The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/97b12e8f9bb877b0d3f5790d353767474b3b2073...9a29a44bef08eafdcb97079f6361260102501fc4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/97b12e8f9bb877b0d3f5790d353767474b3b2073...9a29a44bef08eafdcb97079f6361260102501fc4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 14:17:23 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Fri, 03 Feb 2023 09:17:23 -0500 Subject: [Git][ghc/ghc][wip/js-rts-fixmes] 9 commits: docs: 9.6 release notes for wasm backend Message-ID: <63dd177365e0e_1108fe5265c629147@gitlab.mail> Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC Commits: 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - c4d417cd by Josh Meredith at 2023-02-03T14:17:14+00:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} - - - - - ad3bfdb7 by Josh Meredith at 2023-02-03T14:17:14+00:00 Cache names used commonly in JS backend RTS generation - - - - - 23 changed files: - .gitlab/ci.sh - compiler/GHC/CmmToLlvm/Mangler.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/JS/Make.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/ghc.cabal.in - docs/users_guide/9.6.1-notes.rst - libraries/base/GHC/IO/Handle/Types.hs - libraries/containers - libraries/ghci/GHCi/InfoTable.hsc - m4/ghc_tables_next_to_code.m4 - rts/posix/Ticker.c - rts/posix/ticker/Pthread.c - + rts/posix/ticker/TimerFd.c - testsuite/tests/driver/fat-iface/Makefile - + testsuite/tests/driver/fat-iface/T22807.stdout - + testsuite/tests/driver/fat-iface/T22807A.hs - + testsuite/tests/driver/fat-iface/T22807B.hs - + testsuite/tests/driver/fat-iface/T22807_ghci.hs - + testsuite/tests/driver/fat-iface/T22807_ghci.script - + testsuite/tests/driver/fat-iface/T22807_ghci.stdout - testsuite/tests/driver/fat-iface/all.T Changes: ===================================== .gitlab/ci.sh ===================================== @@ -214,8 +214,6 @@ function set_toolchain_paths() { cat toolchain.sh fi source toolchain.sh - info "--info for GHC for $NIX_SYSTEM" - $GHC --info ;; env) # These are generally set by the Docker image but @@ -274,6 +272,11 @@ function setup() { show_tool CABAL show_tool HAPPY show_tool ALEX + + info "=====================================================" + info "ghc --info" + info "=====================================================" + $GHC --info } function fetch_ghc() { ===================================== compiler/GHC/CmmToLlvm/Mangler.hs ===================================== @@ -38,7 +38,7 @@ llvmFixupAsm platform f1 f2 = {-# SCC "llvm_mangler" #-} -- | These are the rewrites that the mangler will perform rewrites :: [Rewrite] -rewrites = [rewriteSymType, rewriteAVX, rewriteCall] +rewrites = [rewriteSymType, rewriteAVX, rewriteCall, rewriteJump] type Rewrite = Platform -> B.ByteString -> Maybe B.ByteString @@ -123,6 +123,29 @@ rewriteCall platform l removePlt = replaceOnce (B.pack "@plt") (B.pack "") appendInsn i = (`B.append` B.pack ("\n\t" ++ i)) +-- | This rewrites bl and b jump inst to avoid creating PLT entries for +-- functions on loongarch64, because there is no separate call instruction +-- for function calls in loongarch64. Also, this replacement will load +-- the function address from the GOT, which is resolved to point to the +-- real address of the function. +rewriteJump :: Rewrite +rewriteJump platform l + | not isLoongArch64 = Nothing + | isBL l = Just $ replaceJump "bl" "$ra" "$ra" l + | isB l = Just $ replaceJump "b" "$zero" "$t0" l + | otherwise = Nothing + where + isLoongArch64 = platformArch platform == ArchLoongArch64 + isBL = B.isPrefixOf (B.pack "bl\t") + isB = B.isPrefixOf (B.pack "b\t") + + replaceJump jump rd rj l = + appendInsn ("jirl" ++ "\t" ++ rd ++ ", " ++ rj ++ ", 0") $ removeBracket $ + replaceOnce (B.pack (jump ++ "\t%plt(")) (B.pack ("la\t" ++ rj ++ ", ")) l + where + removeBracket = replaceOnce (B.pack ")") (B.pack "") + appendInsn i = (`B.append` B.pack ("\n\t" ++ i)) + -- | @replaceOnce match replace bs@ replaces the first occurrence of the -- substring @match@ in @bs@ with @replace at . replaceOnce :: B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -604,8 +604,12 @@ toIfaceTopBind b = IfLclTopBndr {} -> IfRhs (toIfaceExpr rhs) in (top_bndr, rhs') - already_has_unfolding b = - -- The identifier has an unfolding, which we are going to serialise anyway + -- The sharing behaviour is currently disabled due to #22807, and relies on + -- finished #220056 to be re-enabled. + disabledDueTo22807 = True + + already_has_unfolding b = not disabledDueTo22807 + && -- The identifier has an unfolding, which we are going to serialise anyway hasCoreUnfolding (realIdUnfolding b) -- But not a stable unfolding, we want the optimised unfoldings. && not (isStableUnfolding (realIdUnfolding b)) @@ -771,7 +775,10 @@ is that these NOINLINE'd functions now can't be profitably inlined outside of the hs-boot loop. Note [Interface File with Core: Sharing RHSs] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +IMPORTANT: This optimisation is currently disabled due to #22027, it can be + re-enabled once #220056 is implemented. In order to avoid duplicating definitions for bindings which already have unfoldings we do some minor headstands to avoid serialising the RHS of a definition if it has ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -933,7 +933,13 @@ tc_iface_bindings (IfaceRec bs) = do -- | See Note [Interface File with Core: Sharing RHSs] tc_iface_binding :: Id -> IfaceMaybeRhs -> IfL CoreExpr -tc_iface_binding i IfUseUnfoldingRhs = return (unfoldingTemplate $ realIdUnfolding i) +tc_iface_binding i IfUseUnfoldingRhs = + case maybeUnfoldingTemplate $ realIdUnfolding i of + Just e -> return e + Nothing -> pprPanic "tc_iface_binding" (vcat [text "Binding" <+> quotes (ppr i) <+> text "had an unfolding when the interface file was created" + , text "which has now gone missing, something has badly gone wrong." + , text "Unfolding:" <+> ppr (realIdUnfolding i)]) + tc_iface_binding _ (IfRhs rhs) = tcIfaceExpr rhs mk_top_id :: IfaceTopBndrInfo -> IfL Id ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -129,7 +129,10 @@ module GHC.JS.Make -- * Miscellaneous -- $misc , allocData, allocClsA + , dataName + , clsName , dataFieldName, dataFieldNames + , varName, varNames ) where @@ -646,7 +649,7 @@ nFieldCache = 16384 dataFieldName :: Int -> FastString dataFieldName i - | i < 1 || i > nFieldCache = panic "dataFieldName" (ppr i) + | i < 0 || i > nFieldCache = panic "dataFieldName" (ppr i) | otherwise = dataFieldCache ! i dataFieldNames :: [FastString] @@ -657,6 +660,11 @@ dataFieldNames = fmap dataFieldName [1..nFieldCache] dataCache :: Array Int FastString dataCache = listArray (0,1024) (map (mkFastString . ("h$d"++) . show) [(0::Int)..1024]) +dataName :: Int -> FastString +dataName i + | i < 0 || i > 1024 = panic "dataCacheName" (ppr i) + | otherwise = dataCache ! i + allocData :: Int -> JExpr allocData i = toJExpr (TxtI (dataCache ! i)) @@ -664,9 +672,26 @@ allocData i = toJExpr (TxtI (dataCache ! i)) clsCache :: Array Int FastString clsCache = listArray (0,1024) (map (mkFastString . ("h$c"++) . show) [(0::Int)..1024]) +clsName :: Int -> FastString +clsName i + | i < 0 || i > 1024 = panic "clsCacheName" (ppr i) + | otherwise = clsCache ! i + allocClsA :: Int -> JExpr allocClsA i = toJExpr (TxtI (clsCache ! i)) +-- | Cache "xXXX" names +varCache :: Array Int FastString +varCache = listArray (0,1024) (map (mkFastString . ('x':) . show) [(0::Int)..1024]) + +varName :: Int -> Ident +varName i + | i < 0 || i > 1024 = panic "varCacheName" (ppr i) + | otherwise = TxtI $ varCache ! i + +varNames :: [Ident] +varNames = fmap varName [1..1024] + -------------------------------------------------------------------------------- -- New Identifiers ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -81,35 +81,7 @@ resetResultVar r = toJExpr r |= null_ -- JIT can optimize better. closureConstructors :: StgToJSConfig -> JStat closureConstructors s = BlockStat - [ declClsConstr "h$c" ["f"] $ Closure - { clEntry = var "f" - , clField1 = null_ - , clField2 = null_ - , clMeta = 0 - , clCC = ccVal - } - , declClsConstr "h$c0" ["f"] $ Closure - { clEntry = var "f" - , clField1 = null_ - , clField2 = null_ - , clMeta = 0 - , clCC = ccVal - } - , declClsConstr "h$c1" ["f", "x1"] $ Closure - { clEntry = var "f" - , clField1 = var "x1" - , clField2 = null_ - , clMeta = 0 - , clCC = ccVal - } - , declClsConstr "h$c2" ["f", "x1", "x2"] $ Closure - { clEntry = var "f" - , clField1 = var "x1" - , clField2 = var "x2" - , clMeta = 0 - , clCC = ccVal - } - , mconcat (map mkClosureCon [3..24]) + [ mconcat (map mkClosureCon (Nothing : map Just [0..24])) , mconcat (map mkDataFill [1..24]) ] where @@ -118,19 +90,8 @@ closureConstructors s = BlockStat -- the cc argument happens to be named just like the cc field... | prof = ([TxtI closureCC_], Just (var closureCC_)) | otherwise = ([], Nothing) - addCCArg as = map TxtI as ++ ccArg addCCArg' as = as ++ ccArg - declClsConstr i as cl = TxtI i ||= ValExpr (JFunc (addCCArg as) - ( jVar $ \x -> - [ checkC - , x |= newClosure cl - , notifyAlloc x - , traceAlloc x - , returnS x - ] - )) - traceAlloc x | csTraceRts s = appS "h$traceAlloc" [x] | otherwise = mempty @@ -172,26 +133,36 @@ closureConstructors s = BlockStat | otherwise = mempty - mkClosureCon :: Int -> JStat - mkClosureCon n = funName ||= toJExpr fun + mkClosureCon :: Maybe Int -> JStat + mkClosureCon n0 = funName ||= toJExpr fun where - funName = TxtI $ mkFastString ("h$c" ++ show n) + n | Just n' <- n0 = n' + | Nothing <- n0 = 0 + funName | Just n' <- n0 = TxtI $ clsName n' + | Nothing <- n0 = TxtI $ mkFastString "h$c" -- args are: f x1 x2 .. xn [cc] - args = TxtI "f" : addCCArg' (map (TxtI . mkFastString . ('x':) . show) [(1::Int)..n]) + args = TxtI "f" : addCCArg' (take n varNames) fun = JFunc args funBod -- x1 goes into closureField1. All the other args are bundled into an -- object in closureField2: { d1 = x2, d2 = x3, ... } -- - extra_args = ValExpr . JHash . listToUniqMap $ zip - (map (mkFastString . ('d':) . show) [(1::Int)..]) - (map (toJExpr . TxtI . mkFastString . ('x':) . show) [2..n]) + vars = map toJExpr $ take n varNames + + x1 = case vars of + [] -> null_ + x:_ -> x + x2 = case vars of + [] -> null_ + [_] -> null_ + [_,x] -> x + _:x:xs -> ValExpr . JHash . listToUniqMap $ zip dataFieldNames (x:xs) funBod = jVar $ \x -> [ checkC , x |= newClosure Closure { clEntry = var "f" - , clField1 = var "x1" - , clField2 = extra_args + , clField1 = x1 + , clField2 = x2 , clMeta = 0 , clCC = ccVal } @@ -203,10 +174,9 @@ closureConstructors s = BlockStat mkDataFill :: Int -> JStat mkDataFill n = funName ||= toJExpr fun where - funName = TxtI $ mkFastString ("h$d" ++ show n) - ds = map (mkFastString . ('d':) . show) [(1::Int)..n] - extra_args = ValExpr . JHash . listToUniqMap . zip ds $ map (toJExpr . TxtI) ds - fun = JFunc (map TxtI ds) (checkD <> returnS extra_args) + funName = TxtI $ dataName n + extra_args = ValExpr . JHash . listToUniqMap . zip dataFieldNames $ map (toJExpr . TxtI) dataFieldNames + fun = JFunc (map TxtI dataFieldNames) (checkD <> returnS extra_args) -- | JS Payload to perform stack manipulation in the RTS stackManip :: JStat @@ -215,7 +185,7 @@ stackManip = mconcat (map mkPush [1..32]) <> where mkPush :: Int -> JStat mkPush n = let funName = TxtI $ mkFastString ("h$p" ++ show n) - as = map (TxtI . mkFastString . ('x':) . show) [1..n] + as = take n varNames fun = JFunc as ((sp |= sp + toJExpr n) <> mconcat (zipWith (\i a -> stack .! (sp - toJExpr (n-i)) |= toJExpr a) [1..] as)) @@ -228,7 +198,7 @@ stackManip = mconcat (map mkPush [1..32]) <> bits = bitsIdx sig n = length bits h = last bits - args = map (TxtI . mkFastString . ('x':) . show) [1..n] + args = take n varNames fun = JFunc args $ mconcat [ sp |= sp + toJExpr (h+1) , mconcat (zipWith (\b a -> stack .! (sp - toJExpr (h-b)) |= toJExpr a) bits args) @@ -288,7 +258,7 @@ loadRegs :: JStat loadRegs = mconcat $ map mkLoad [1..32] where mkLoad :: Int -> JStat - mkLoad n = let args = map (TxtI . mkFastString . ("x"++) . show) [1..n] + mkLoad n = let args = take n varNames assign = zipWith (\a r -> toJExpr r |= toJExpr a) args (reverse $ take n regsFromR1) fname = TxtI $ mkFastString ("h$l" ++ show n) ===================================== compiler/ghc.cabal.in ===================================== @@ -557,6 +557,7 @@ Library GHC.Platform.ARM GHC.Platform.AArch64 GHC.Platform.Constants + GHC.Platform.LoongArch64 GHC.Platform.NoRegs GHC.Platform.PPC GHC.Platform.Profile @@ -564,7 +565,6 @@ Library GHC.Platform.Reg.Class GHC.Platform.Regs GHC.Platform.RISCV64 - GHC.Platform.LoongArch64 GHC.Platform.S390X GHC.Platform.Wasm32 GHC.Platform.Ways ===================================== docs/users_guide/9.6.1-notes.rst ===================================== @@ -90,6 +90,22 @@ Language Compiler ~~~~~~~~ +- The `WebAssembly backend + `_ + has been merged. This allows GHC to be built as a cross-compiler + that targets ``wasm32-wasi`` and compiles Haskell code to + self-contained WebAssembly modules that can be executed on a variety + of different runtimes. There are a few caveats to be aware of: + + - To use the WebAssembly backend, one would need to follow the + instructions on `ghc-wasm-meta + `_. The WebAssembly + backend is not included in the GHC release bindists for the time + being, nor is it supported by ``ghcup`` or ``stack`` yet. + - The WebAssembly backend is still under active development. It's + presented in this GHC version as a technology preview, bugs and + missing features are expected. + - The :extension:`TypeInType` is now marked as deprecated. Its meaning has been included in :extension:`PolyKinds` and :extension:`DataKinds`. ===================================== libraries/base/GHC/IO/Handle/Types.hs ===================================== @@ -124,11 +124,11 @@ data Handle__ Handle__ { haDevice :: !dev, haType :: HandleType, -- type (read/write/append etc.) - haByteBuffer :: !(IORef (Buffer Word8)), -- See [note Buffering Implementation] + haByteBuffer :: !(IORef (Buffer Word8)), -- See Note [Buffering Implementation] haBufferMode :: BufferMode, haLastDecode :: !(IORef (dec_state, Buffer Word8)), -- ^ The byte buffer just before we did our last batch of decoding. - haCharBuffer :: !(IORef (Buffer CharBufElem)), -- See [note Buffering Implementation] + haCharBuffer :: !(IORef (Buffer CharBufElem)), -- See Note [Buffering Implementation] haBuffers :: !(IORef (BufferList CharBufElem)), -- spare buffers haEncoder :: Maybe (TextEncoder enc_state), haDecoder :: Maybe (TextDecoder dec_state), @@ -261,13 +261,13 @@ data BufferMode ) {- -[note Buffering Implementation] - +Note [Buffering Implementation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Each Handle has two buffers: a byte buffer (haByteBuffer) and a Char buffer (haCharBuffer). -[note Buffered Reading] - +Note [Buffered Reading] +~~~~~~~~~~~~~~~~~~~~~~~ For read Handles, bytes are read into the byte buffer, and immediately decoded into the Char buffer (see GHC.IO.Handle.Internals.readTextDevice). The only way there might be @@ -279,8 +279,8 @@ reading data into a Handle. When reading, we can always just read all the data there is available without blocking, decode it into the Char buffer, and then provide it immediately to the caller. -[note Buffered Writing] - +Note [Buffered Writing] +~~~~~~~~~~~~~~~~~~~~~~~ Characters are written into the Char buffer by e.g. hPutStr. At the end of the operation, or when the char buffer is full, the buffer is decoded to the byte buffer (see writeCharBuffer). This is so that we @@ -288,8 +288,8 @@ can detect encoding errors at the right point. Hence, the Char buffer is always empty between Handle operations. -[note Buffer Sizing] - +Note [Buffer Sizing] +~~~~~~~~~~~~~~~~~~~~ The char buffer is always a default size (dEFAULT_CHAR_BUFFER_SIZE). The byte buffer size is chosen by the underlying device (via its IODevice.newBuffer). Hence the size of these buffers is not under @@ -322,8 +322,8 @@ writeCharBuffer, which checks whether the buffer should be flushed according to the current buffering mode. Additionally, we look for newlines and flush if the mode is LineBuffering. -[note Buffer Flushing] - +Note [Buffer Flushing] +~~~~~~~~~~~~~~~~~~~~~~ ** Flushing the Char buffer We must be able to flush the Char buffer, in order to implement ===================================== libraries/containers ===================================== @@ -1 +1 @@ -Subproject commit fbafcf704f0febd9ddac84dbe00ae3787af43550 +Subproject commit 9f4a93604c66a5e605ce46fc30003b71802b3cfd ===================================== libraries/ghci/GHCi/InfoTable.hsc ===================================== @@ -228,6 +228,15 @@ mkJumpToAddr a = case hostPlatformArch of , fromIntegral w64 , fromIntegral (w64 `shiftR` 32) ] + ArchLoongArch64 -> pure $ + let w64 = fromIntegral (funPtrToInt a) :: Word64 + in Right [ 0x1c00000c -- pcaddu12i $t0,0 + , 0x28c0418c -- ld.d $t0,$t0,16 + , 0x4c000180 -- jr $t0 + , 0x03400000 -- nop + , fromIntegral w64 + , fromIntegral (w64 `shiftR` 32) ] + arch -> -- The arch isn't supported. You either need to add your architecture as a -- distinct case, or use non-TABLES_NEXT_TO_CODE mode. ===================================== m4/ghc_tables_next_to_code.m4 ===================================== @@ -17,7 +17,7 @@ AC_DEFUN([GHC_TABLES_NEXT_TO_CODE], case "$Unregisterised" in NO) case "$TargetArch" in - ia64|powerpc64|powerpc64le|s390x|wasm32|loongarch64) + ia64|powerpc64|powerpc64le|s390x|wasm32) TablesNextToCodeDefault=NO AC_MSG_RESULT([no]) ;; ===================================== rts/posix/Ticker.c ===================================== @@ -65,13 +65,17 @@ * On Linux we can use timerfd_* (introduced in Linux * 2.6.25) and a thread instead of alarm signals. It avoids the risk of * interrupting syscalls (see #10840) and the risk of being accidentally - * modified in user code using signals. + * modified in user code using signals. NetBSD has also added timerfd + * support since version 10. + * + * For older version of linux/netbsd without timerfd we fall back to the + * pthread based implementation. */ -#if defined(linux_HOST_OS) && HAVE_SYS_TIMERFD_H -#define USE_PTHREAD_FOR_ITIMER +#if HAVE_SYS_TIMERFD_H +#define USE_TIMERFD_FOR_ITIMER #endif -#if defined(freebsd_HOST_OS) +#if defined(linux_HOST_OS) #define USE_PTHREAD_FOR_ITIMER #endif @@ -79,6 +83,10 @@ #define USE_PTHREAD_FOR_ITIMER #endif +#if defined(freebsd_HOST_OS) +#define USE_PTHREAD_FOR_ITIMER +#endif + #if defined(solaris2_HOST_OS) /* USE_TIMER_CREATE is usually disabled for Solaris. In fact it is supported well on this OS, but requires additional privilege. When @@ -98,7 +106,9 @@ ghc-stage2: timer_create: Not owner #endif /* solaris2_HOST_OS */ // Select the variant to use -#if defined(USE_PTHREAD_FOR_ITIMER) +#if defined(USE_TIMERFD_FOR_ITIMER) +#include "ticker/TimerFd.c" +#elif defined(USE_PTHREAD_FOR_ITIMER) #include "ticker/Pthread.c" #elif defined(USE_TIMER_CREATE) #include "ticker/TimerCreate.c" ===================================== rts/posix/ticker/Pthread.c ===================================== @@ -63,13 +63,6 @@ #include #include -#if defined(HAVE_SYS_TIMERFD_H) -#include -#define USE_TIMERFD_FOR_ITIMER 1 -#else -#define USE_TIMERFD_FOR_ITIMER 0 -#endif - /* * TFD_CLOEXEC has been added in Linux 2.6.26. * If it is not available, we use fcntl(F_SETFD). @@ -93,61 +86,16 @@ static Condition start_cond; static Mutex mutex; 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) { - if (poll(pollfds, 2, -1) == -1) { - sysErrorBelch("Ticker: poll failed: %s", strerror(errno)); - } - - // 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) { - sysErrorBelch("Ticker: sleep failed: %s", strerror(errno)); - } + if (rtsSleep(itimer_interval) != 0) { + sysErrorBelch("Ticker: sleep failed: %s", strerror(errno)); } // first try a cheap test @@ -164,10 +112,6 @@ static void *itimer_thread_func(void *_handle_tick) } } - if (USE_TIMERFD_FOR_ITIMER) { - close(timerfd); - } - return NULL; } @@ -186,39 +130,6 @@ initTicker (Time interval, TickProc handle_tick) initCondition(&start_cond); initMutex(&mutex); - /* Open the file descriptor for the timer synchronously. - * - * We used to do it in itimer_thread_func (i.e. in the timer thread) but it - * meant that some user code could run before it and get confused by the - * allocation of the timerfd. - * - * See hClose002 which unsafely closes a file descriptor twice expecting an - * exception the second time: it sometimes failed when the second call to - * "close" closed our own timerfd which inadvertently reused the same file - * descriptor closed by the first call! (see #20618) - */ -#if USE_TIMERFD_FOR_ITIMER - struct itimerspec it; - it.it_value.tv_sec = TimeToSeconds(itimer_interval); - it.it_value.tv_nsec = TimeToNS(itimer_interval) % 1000000000; - it.it_interval = it.it_value; - - timerfd = timerfd_create(CLOCK_MONOTONIC, TFD_CLOEXEC); - if (timerfd == -1) { - barf("timerfd_create: %s", strerror(errno)); - } - if (!TFD_CLOEXEC) { - fcntl(timerfd, F_SETFD, FD_CLOEXEC); - } - if (timerfd_settime(timerfd, 0, &it, NULL)) { - barf("timerfd_settime: %s", strerror(errno)); - } - - if (pipe(pipefds) < 0) { - barf("pipe: %s", strerror(errno)); - } -#endif - /* * Create the thread with all blockable signals blocked, leaving signal * handling to the main and/or other threads. This is especially useful in @@ -269,21 +180,9 @@ 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 { ===================================== rts/posix/ticker/TimerFd.c ===================================== @@ -0,0 +1,280 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1995-2023 + * + * Interval timer for profiling and pre-emptive scheduling. + * + * ---------------------------------------------------------------------------*/ + +/* + * We use a realtime timer by default. I found this much more + * reliable than a CPU timer: + * + * Experiments with different frequencies: using + * CLOCK_REALTIME/CLOCK_MONOTONIC on Linux 2.6.32, + * 1000us has <1% impact on runtime + * 100us has ~2% impact on runtime + * 10us has ~40% impact on runtime + * + * using CLOCK_PROCESS_CPUTIME_ID on Linux 2.6.32, + * I cannot get it to tick faster than 10ms (10000us) + * which isn't great for profiling. + * + * In the threaded RTS, we can't tick in CPU time because the thread + * which has the virtual timer might be idle, so the tick would never + * fire. Therefore we used to tick in realtime in the threaded RTS and + * in CPU time otherwise, but now we always tick in realtime, for + * several reasons: + * + * - resolution (see above) + * - consistency (-threaded is the same as normal) + * - more consistency: Windows only has a realtime timer + * + * Note we want to use CLOCK_MONOTONIC rather than CLOCK_REALTIME, + * because the latter may jump around (NTP adjustments, leap seconds + * etc.). + */ + +#include "rts/PosixSource.h" +#include "Rts.h" + +#include "Ticker.h" +#include "RtsUtils.h" +#include "Proftimer.h" +#include "Schedule.h" +#include "posix/Clock.h" +#include + +#include +#if HAVE_SYS_TIME_H +# include +#endif + +#if defined(HAVE_SIGNAL_H) +# include +#endif + +#include + +#include +#if defined(HAVE_PTHREAD_NP_H) +#include +#endif +#include +#include + +#include + + +/* + * TFD_CLOEXEC has been added in Linux 2.6.26. + * If it is not available, we use fcntl(F_SETFD). + */ +#if !defined(TFD_CLOEXEC) +#define TFD_CLOEXEC 0 +#endif + +static Time itimer_interval = DEFAULT_TICK_INTERVAL; + +// Should we be firing ticks? +// Writers to this must hold the mutex below. +static bool stopped = false; + +// should the ticker thread exit? +// This can be set without holding the mutex. +static bool exited = true; + +// Signaled when we want to (re)start the timer +static Condition start_cond; +static Mutex mutex; +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]; + + pollfds[0].fd = pipefds[0]; + pollfds[0].events = POLLIN; + pollfds[1].fd = timerfd; + pollfds[1].events = POLLIN; + + // 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 (poll(pollfds, 2, -1) == -1) { + sysErrorBelch("Ticker: poll failed: %s", strerror(errno)); + } + + // 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); + } + } + + // first try a cheap test + TSAN_ANNOTATE_BENIGN_RACE(&stopped, "itimer_thread_func"); + if (RELAXED_LOAD(&stopped)) { + OS_ACQUIRE_LOCK(&mutex); + // should we really stop? + if (stopped) { + waitCondition(&start_cond, &mutex); + } + OS_RELEASE_LOCK(&mutex); + } else { + handle_tick(0); + } + } + + close(timerfd); + return NULL; +} + +void +initTicker (Time interval, TickProc handle_tick) +{ + itimer_interval = interval; + stopped = true; + exited = false; +#if defined(HAVE_SIGNAL_H) + sigset_t mask, omask; + int sigret; +#endif + int ret; + + initCondition(&start_cond); + initMutex(&mutex); + + /* Open the file descriptor for the timer synchronously. + * + * We used to do it in itimer_thread_func (i.e. in the timer thread) but it + * meant that some user code could run before it and get confused by the + * allocation of the timerfd. + * + * See hClose002 which unsafely closes a file descriptor twice expecting an + * exception the second time: it sometimes failed when the second call to + * "close" closed our own timerfd which inadvertently reused the same file + * descriptor closed by the first call! (see #20618) + */ + struct itimerspec it; + it.it_value.tv_sec = TimeToSeconds(itimer_interval); + it.it_value.tv_nsec = TimeToNS(itimer_interval) % 1000000000; + it.it_interval = it.it_value; + + timerfd = timerfd_create(CLOCK_MONOTONIC, TFD_CLOEXEC); + if (timerfd == -1) { + barf("timerfd_create: %s", strerror(errno)); + } + if (!TFD_CLOEXEC) { + fcntl(timerfd, F_SETFD, FD_CLOEXEC); + } + if (timerfd_settime(timerfd, 0, &it, NULL)) { + barf("timerfd_settime: %s", strerror(errno)); + } + + if (pipe(pipefds) < 0) { + barf("pipe: %s", strerror(errno)); + } + + /* + * Create the thread with all blockable signals blocked, leaving signal + * handling to the main and/or other threads. This is especially useful in + * the non-threaded runtime, where applications might expect sigprocmask(2) + * to effectively block signals. + */ +#if defined(HAVE_SIGNAL_H) + sigfillset(&mask); + sigret = pthread_sigmask(SIG_SETMASK, &mask, &omask); +#endif + ret = createAttachedOSThread(&thread, "ghc_ticker", itimer_thread_func, (void*)handle_tick); +#if defined(HAVE_SIGNAL_H) + if (sigret == 0) + pthread_sigmask(SIG_SETMASK, &omask, NULL); +#endif + + if (ret != 0) { + barf("Ticker: Failed to spawn thread: %s", strerror(errno)); + } +} + +void +startTicker(void) +{ + OS_ACQUIRE_LOCK(&mutex); + RELAXED_STORE(&stopped, false); + signalCondition(&start_cond); + OS_RELEASE_LOCK(&mutex); +} + +/* There may be at most one additional tick fired after a call to this */ +void +stopTicker(void) +{ + OS_ACQUIRE_LOCK(&mutex); + RELAXED_STORE(&stopped, true); + OS_RELEASE_LOCK(&mutex); +} + +/* There may be at most one additional tick fired after a call to this */ +void +exitTicker (bool wait) +{ + ASSERT(!SEQ_CST_LOAD(&exited)); + SEQ_CST_STORE(&exited, true); + // ensure that ticker wakes up if stopped + startTicker(); + + // wait for ticker to terminate if necessary + if (wait) { + // 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)); + } + + if (pthread_join(thread, NULL)) { + sysErrorBelch("Ticker: Failed to join: %s", strerror(errno)); + } + + // 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]); + + closeMutex(&mutex); + closeCondition(&start_cond); + } else { + pthread_detach(thread); + } +} + +int +rtsTimerSignal(void) +{ + return SIGALRM; +} ===================================== testsuite/tests/driver/fat-iface/Makefile ===================================== @@ -49,4 +49,11 @@ fat010: clean echo >> "THB.hs" "$(TEST_HC)" $(TEST_HC_OPTS) THC.hs -fhide-source-paths -fwrite-if-simplified-core -fprefer-byte-code +T22807: clean + "$(TEST_HC)" $(TEST_HC_OPTS) T22807A.hs -fhide-source-paths -fwrite-if-simplified-core -fbyte-code-and-object-code -fno-omit-interface-pragmas -fprefer-byte-code + "$(TEST_HC)" $(TEST_HC_OPTS) T22807B.hs -fhide-source-paths -fwrite-if-simplified-core -fprefer-byte-code -fbyte-code-and-object-code -fno-omit-interface-pragmas + +T22807_ghci: clean + "$(TEST_HC)" $(TEST_HC_OPTS) T22807_ghci.hs -fno-full-laziness -fhide-source-paths -fwrite-if-simplified-core -O2 -dynamic -v0 + "$(TEST_HC)" $(TEST_HC_OPTS) -v0 --interactive -fhide-source-paths -fno-full-laziness < T22807_ghci.script ===================================== testsuite/tests/driver/fat-iface/T22807.stdout ===================================== @@ -0,0 +1,2 @@ +[1 of 1] Compiling T22807A +[2 of 2] Compiling T22807B ===================================== testsuite/tests/driver/fat-iface/T22807A.hs ===================================== @@ -0,0 +1,6 @@ +module T22807A where + +xs :: [a] +xs = [] + + ===================================== testsuite/tests/driver/fat-iface/T22807B.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE TemplateHaskell #-} +module T22807B where +import T22807A + +$(pure xs) ===================================== testsuite/tests/driver/fat-iface/T22807_ghci.hs ===================================== @@ -0,0 +1,8 @@ +module T22807_ghci where + + +foo b = + let x = Just [1..1000] + in if b + then Left x + else Right x ===================================== testsuite/tests/driver/fat-iface/T22807_ghci.script ===================================== @@ -0,0 +1,6 @@ +:l T22807_ghci.hs + +import T22807_ghci +import Data.Either + +isLeft (foo True) ===================================== testsuite/tests/driver/fat-iface/T22807_ghci.stdout ===================================== @@ -0,0 +1 @@ +True ===================================== testsuite/tests/driver/fat-iface/all.T ===================================== @@ -15,5 +15,9 @@ test('fat013', [req_th, extra_files(['FatTH.hs', 'FatQuote.hs'])], multimod_comp # When using interpreter should not produce objects test('fat014', [req_th, extra_files(['FatTH.hs', 'FatQuote.hs']), extra_run_opts('-fno-code')], ghci_script, ['fat014.script']) test('fat015', [req_th, unless(ghc_dynamic(), skip), extra_files(['FatQuote.hs', 'FatQuote1.hs', 'FatQuote2.hs', 'FatTH1.hs', 'FatTH2.hs', 'FatTHTop.hs'])], multimod_compile, ['FatTHTop', '-fno-code -fwrite-interface']) +test('T22807', [req_th, unless(ghc_dynamic(), skip), extra_files(['T22807A.hs', 'T22807B.hs'])] + , makefile_test, ['T22807']) +test('T22807_ghci', [req_th, unless(ghc_dynamic(), skip), extra_files(['T22807_ghci.hs'])] + , makefile_test, ['T22807_ghci']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bc14c389743bcf0f58cc3d73370d40738ab92181...ad3bfdb7683d68061f04f08a70ab20c4578a490d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bc14c389743bcf0f58cc3d73370d40738ab92181...ad3bfdb7683d68061f04f08a70ab20c4578a490d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 14:22:59 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Fri, 03 Feb 2023 09:22:59 -0500 Subject: [Git][ghc/ghc][wip/T22740] More Message-ID: <63dd18c31d662_1108fe193a73986293f7@gitlab.mail> Sylvain Henry pushed to branch wip/T22740 at Glasgow Haskell Compiler / GHC Commits: 2cef38b1 by Sylvain Henry at 2023-02-03T15:27:24+01:00 More - - - - - 3 changed files: - hadrian/bindist/config.mk.in - m4/ghc_unregisterised.m4 - rts/rts.cabal.in Changes: ===================================== hadrian/bindist/config.mk.in ===================================== @@ -128,7 +128,7 @@ GhcUnregisterised = @Unregisterised@ ifeq "$(TargetArch_CPP)" "arm" # We don't support load/store barriers pre-ARMv7. See #10433. ArchSupportsSMP=$(if $(filter $(ARM_ISA),ARMv5 ARMv6),NO,YES) -else ifeq "$(TargetArch_CPP)" "js" +else ifeq "$(TargetArch_CPP)" "javascript" ArchSupportsSMP=NO else ArchSupportsSMP=$(strip $(patsubst $(TargetArch_CPP), YES, $(findstring $(TargetArch_CPP), i386 x86_64 sparc powerpc powerpc64 powerpc64le s390x aarch64 riscv64))) ===================================== m4/ghc_unregisterised.m4 ===================================== @@ -5,7 +5,7 @@ AC_DEFUN([GHC_UNREGISTERISED], [ AC_MSG_CHECKING(whether target supports a registerised ABI) case "$TargetArch" in - i386|x86_64|powerpc|powerpc64|powerpc64le|s390x|arm|aarch64|riscv64|wasm32|js|loongarch64) + i386|x86_64|powerpc|powerpc64|powerpc64le|s390x|arm|aarch64|riscv64|wasm32|javascript|loongarch64) UnregisterisedDefault=NO AC_MSG_RESULT([yes]) ;; ===================================== rts/rts.cabal.in ===================================== @@ -84,7 +84,7 @@ library exposed: True exposed-modules: - if os(ghcjs) + if arch(javascript) include-dirs: include -- dummy file to force the build of a .a lib View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2cef38b1b3030b9bf51c8519fcc9c43b597f1b3a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2cef38b1b3030b9bf51c8519fcc9c43b597f1b3a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 15:10:37 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Fri, 03 Feb 2023 10:10:37 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/misc-cleanup5 Message-ID: <63dd23ed71151_1108fe526346420df@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/misc-cleanup5 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/misc-cleanup5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 15:23:52 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Fri, 03 Feb 2023 10:23:52 -0500 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] 4 commits: Use StackFrameIter instead of BitmapEntry Message-ID: <63dd27084e7e0_1108fe526346441f2@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: 69405da8 by Sven Tennie at 2023-02-03T12:30:05+00:00 Use StackFrameIter instead of BitmapEntry - - - - - e1e3b80a by Sven Tennie at 2023-02-03T12:41:52+00:00 Update note - - - - - 82bea903 by Sven Tennie at 2023-02-03T12:47:42+00:00 Cleanup - - - - - fe83579e by Sven Tennie at 2023-02-03T12:51:26+00:00 Remove unsafe cast - - - - - 2 changed files: - libraries/ghc-heap/GHC/Exts/DecodeStack.hs - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs Changes: ===================================== libraries/ghc-heap/GHC/Exts/DecodeStack.hs ===================================== @@ -55,33 +55,37 @@ the same. (Though, the absolute addresses change!) Stack frame iterator ==================== -A StackFrameIter consists of a StackSnapshot# and a relative offset into the the -array of stack frames (StgStack->stack). The StackSnapshot# represents a -StgStack closure. It is updated by the garbage collector when the stack closure -is moved. +A stack frame interator (StackFrameIter) consists of a StackSnapshot# and a +relative offset into the the array of stack frames (StgStack->stack). The +StackSnapshot# represents a StgStack closure. It is updated by the garbage +collector when the stack closure is moved. The relative offset describes the location of a stack frame. As stack frames come in various sizes, one cannot simply step over the stack array with a constant offset. The head of the stack frame array has offset 0. To traverse the stack frames the -latest stacke frame's offset is incremented by the closure size. The unit of the +latest stack frame's offset is incremented by the closure size. The unit of the offset is machine words (32bit or 64bit). +Additionally, StackFrameIter contains a flag (isPrimitive) to indicate if a +location on the stack should be interpreted as plain data word (in contrast to +being a closure or a pointer to a closure.) It's used when bitmap encoded +arguments are interpreted. + Boxes ===== -As references into thestack frame array aren't updated by the garbage collector, +As references into the stack frame array aren't updated by the garbage collector, creating a Box with a pointer (address) to a stack frame would break as soon as the StgStack closure is moved. -To deal with this another kind of Box is introduced: A DecodedBox contains a -thunk for a decoded stack frame or the closure for the decoded stack frame -itself. I.e. we're not boxing the closure, but the ghc-heap representation of -it. +To deal with this another kind of Box is introduced: A StackFrameBox contains a +stack frame iterator for a decoded stack frame or it's payload. Heap-represented closures referenced by stack frames are boxed the usual way, -with a Box that contains a pointer to the closure. +with a Box that contains a pointer to the closure as it's payload. In +Haskell-land this means: A Box which contains the closure. Technical details ================= @@ -157,7 +161,7 @@ getInfoTable StackFrameIter {..} = let infoTablePtr = Ptr (getInfoTableAddr# stackSnapshot# (wordOffsetToWord# index)) in peekItbl infoTablePtr -foreign import prim "getBoxedClosurezh" getBoxedClosure# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Addr# #) +foreign import prim "getBoxedClosurezh" getBoxedClosure# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Any #) -- -- TODO: Remove this instance (debug only) -- instance Show StackFrameIter where @@ -178,18 +182,13 @@ advanceStackFrameIter (StackFrameIter {..}) = primWordToWordOffset :: Word# -> WordOffset primWordToWordOffset w# = fromIntegral (W# w#) --- TODO: can be just StackFrameIter -data BitmapEntry = BitmapEntry - { closureFrame :: StackFrameIter } - -wordsToBitmapEntries :: StackFrameIter -> [Word] -> Word -> [BitmapEntry] +wordsToBitmapEntries :: StackFrameIter -> [Word] -> Word -> [StackFrameIter] wordsToBitmapEntries _ [] 0 = [] wordsToBitmapEntries _ [] i = error $ "Invalid state: Empty list, size " ++ show i wordsToBitmapEntries _ l 0 = error $ "Invalid state: Size 0, list " ++ show l wordsToBitmapEntries sfi (b : bs) bitmapSize = let entries = toBitmapEntries sfi b (min bitmapSize (fromIntegral wORD_SIZE_IN_BITS)) - mbLastEntry = (listToMaybe . reverse) entries - mbLastFrame = fmap closureFrame mbLastEntry + mbLastFrame = (listToMaybe . reverse) entries in case mbLastFrame of Just (StackFrameIter {..}) -> entries ++ wordsToBitmapEntries (StackFrameIter stackSnapshot# (index + 1) False) bs (subtractDecodedBitmapWord bitmapSize) @@ -198,29 +197,24 @@ wordsToBitmapEntries sfi (b : bs) bitmapSize = subtractDecodedBitmapWord :: Word -> Word subtractDecodedBitmapWord bSize = fromIntegral $ max 0 ((fromIntegral bSize) - wORD_SIZE_IN_BITS) -toBitmapEntries :: StackFrameIter -> Word -> Word -> [BitmapEntry] +toBitmapEntries :: StackFrameIter -> Word -> Word -> [StackFrameIter] toBitmapEntries _ _ 0 = [] toBitmapEntries sfi@(StackFrameIter {..}) bitmapWord bSize = -- TODO: overriding isPrimitive field is a bit weird. Could be calculated before - BitmapEntry - { closureFrame = sfi { + sfi { isPrimitive = (bitmapWord .&. 1) /= 0 } - } : toBitmapEntries (StackFrameIter stackSnapshot# (index + 1) False) (bitmapWord `shiftR` 1) (bSize - 1) -toBitmapPayload :: BitmapEntry -> IO Box -toBitmapPayload e - | (isPrimitive . closureFrame) e = trace "PRIM" $ pure . StackFrameBox $ (closureFrame e) { - isPrimitive = True - } -toBitmapPayload e = getClosure (closureFrame e) 0 +toBitmapPayload :: StackFrameIter -> IO Box +toBitmapPayload sfi | isPrimitive sfi = pure (StackFrameBox sfi) +toBitmapPayload sfi = getClosure sfi 0 getClosure :: StackFrameIter -> WordOffset -> IO Box getClosure sfi at StackFrameIter {..} relativeOffset = trace ("getClosure " ++ show sfi ++ " " ++ show relativeOffset) $ IO $ \s -> case (getBoxedClosure# stackSnapshot# (wordOffsetToWord# (index + relativeOffset)) s) of (# s1, ptr #) -> - (# s1, Box (unsafeCoerce# ptr) #) + (# s1, Box ptr #) decodeLargeBitmap :: (StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, ByteArray#, Word# #)) -> StackFrameIter -> WordOffset -> IO [Box] decodeLargeBitmap getterFun# sfi@(StackFrameIter {..}) relativePayloadOffset = do ===================================== libraries/ghc-heap/GHC/Exts/Heap/Closures.hs ===================================== @@ -81,7 +81,6 @@ foreign import prim "eqStackSnapshotszh" eqStackSnapshots# :: StackSnapshot# -> data StackFrameIter = StackFrameIter { stackSnapshot# :: !StackSnapshot#, index :: !WordOffset, - -- TODO: could be a sum type to prevent boolean-blindness isPrimitive :: !Bool } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ea608c2d3df40d7818c71b332fe4aa6b03e587f3...fe83579e946a3d6a8316bddccf554f51700529af -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ea608c2d3df40d7818c71b332fe4aa6b03e587f3...fe83579e946a3d6a8316bddccf554f51700529af You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 15:57:40 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 03 Feb 2023 10:57:40 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Windows: Remove mingwex dependency Message-ID: <63dd2ef4bb565_1108fe526486603f4@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 027c0e1d by Ryan Scott at 2023-02-03T10:57:19-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 6a81d415 by Tamar Christina at 2023-02-03T10:57:19-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - c8308117 by Ben Gamari at 2023-02-03T10:57:19-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - 3306feca by Andreas Klebinger at 2023-02-03T10:57:20-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - aad5f129 by j at 2023-02-03T10:57:23-05:00 Disable several ignore-warning flags in genapply. - - - - - 29 changed files: - .gitlab-ci.yml - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Types/CostCentre.hs - configure.ac - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Packages.hs - libraries/base/System/Posix/Internals.hs - libraries/base/base.cabal - libraries/base/configure.ac - libraries/base/include/HsBase.h - libraries/ghc-prim/ghc-prim.cabal - mk/get-win32-tarballs.py - rts/Linker.c - rts/LinkerInternals.h - rts/RtsSymbols.c - rts/linker/PEi386.c - rts/rts.cabal.in - testsuite/tests/ghci/linking/dyn/Makefile - testsuite/tests/ghci/linking/dyn/all.T - + testsuite/tests/ghci/linking/dyn/bin_impl_gcc/ASimpL.dll - + testsuite/tests/ghci/linking/dyn/bin_impl_gcc/libASx.dll.a - testsuite/tests/rts/all.T - utils/genapply/Main.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -6,7 +6,7 @@ variables: # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. - CACHE_REV: 9 + CACHE_REV: 10 # Disable shallow clones; they break our linting rules GIT_DEPTH: 0 ===================================== compiler/GHC/Core/LateCC.hs ===================================== @@ -142,7 +142,7 @@ initLateCCState :: LateCCState initLateCCState = LateCCState newCostCentreState mempty getCCFlavour :: FastString -> M CCFlavour -getCCFlavour name = LateCC <$> getCCIndex' name +getCCFlavour name = mkLateCCFlavour <$> getCCIndex' name getCCIndex' :: FastString -> M CostCentreIndex getCCIndex' name = do ===================================== compiler/GHC/Core/Opt/CallerCC.hs ===================================== @@ -84,7 +84,7 @@ doExpr env e@(Var v) span = case revParents env of top:_ -> nameSrcSpan $ varName top _ -> noSrcSpan - cc = NormalCC (ExprCC ccIdx) ccName (thisModule env) span + cc = NormalCC (mkExprCCFlavour ccIdx) ccName (thisModule env) span tick :: CoreTickish tick = ProfNote cc count True pure $ Tick tick e ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -538,7 +538,7 @@ ds_prag_expr (HsPragSCC _ cc) expr = do mod_name <- getModule count <- goptM Opt_ProfCountEntries let nm = sl_fs cc - flavour <- ExprCC <$> getCCIndexDsM nm + flavour <- mkExprCCFlavour <$> getCCIndexDsM nm Tick (ProfNote (mkUserCC nm mod_name (getLocA expr) flavour) count True) <$> dsLExpr expr else dsLExpr expr ===================================== compiler/GHC/HsToCore/Ticks.hs ===================================== @@ -1189,7 +1189,7 @@ mkTickish boxLabel countEntries topOnly pos fvs decl_path = do ProfNotes -> do let nm = mkFastString cc_name - flavour <- HpcCC <$> getCCIndexM nm + flavour <- mkHpcCCFlavour <$> getCCIndexM nm let cc = mkUserCC nm (this_mod env) pos flavour count = countEntries && tte_countEntries env return $ ProfNote cc count True{-scopes-} ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -28,7 +28,7 @@ import {-# SOURCE #-} GHC.Tc.Gen.Expr ( tcCheckMonoExpr ) import {-# SOURCE #-} GHC.Tc.TyCl.PatSyn ( tcPatSynDecl, tcPatSynBuilderBind ) import GHC.Types.Tickish (CoreTickish, GenTickish (..)) -import GHC.Types.CostCentre (mkUserCC, CCFlavour(DeclCC)) +import GHC.Types.CostCentre (mkUserCC, mkDeclCCFlavour) import GHC.Driver.Session import GHC.Data.FastString import GHC.Hs @@ -677,7 +677,7 @@ funBindTicks loc fun_id mod sigs = getOccFS (Var.varName fun_id) cc_name = concatFS [moduleNameFS (moduleName mod), fsLit ".", cc_str] = do - flavour <- DeclCC <$> getCCIndexTcM cc_name + flavour <- mkDeclCCFlavour <$> getCCIndexTcM cc_name let cc = mkUserCC cc_name mod loc flavour return [ProfNote cc True True] | otherwise ===================================== compiler/GHC/Types/CostCentre.hs ===================================== @@ -1,7 +1,9 @@ {-# LANGUAGE DeriveDataTypeable #-} module GHC.Types.CostCentre ( - CostCentre(..), CcName, CCFlavour(..), - -- All abstract except to friend: ParseIface.y + -- All abstract except to friend: ParseIface.y + CostCentre(..), CcName, CCFlavour, + mkCafFlavour, mkExprCCFlavour, mkDeclCCFlavour, mkHpcCCFlavour, + mkLateCCFlavour, mkCallerCCFlavour, pprCostCentre, CostCentreStack, @@ -33,7 +35,6 @@ import GHC.Utils.Outputable import GHC.Types.SrcLoc import GHC.Data.FastString import GHC.Types.CostCentre.State -import GHC.Utils.Panic.Plain import Data.Data @@ -66,24 +67,39 @@ data CostCentre type CcName = FastString +data IndexedCCFlavour + = ExprCC -- ^ Explicitly annotated expression + | DeclCC -- ^ Explicitly annotated declaration + | HpcCC -- ^ Generated by HPC for coverage + | LateCC -- ^ Annotated by the one of the prof-last* passes. + | CallerCC -- ^ Annotated by the one of the prof-last* passes. + deriving (Eq,Ord,Data,Enum) -- | The flavour of a cost centre. -- -- Index fields represent 0-based indices giving source-code ordering of -- centres with the same module, name, and flavour. -data CCFlavour = CafCC -- ^ Auto-generated top-level thunk - | ExprCC !CostCentreIndex -- ^ Explicitly annotated expression - | DeclCC !CostCentreIndex -- ^ Explicitly annotated declaration - | HpcCC !CostCentreIndex -- ^ Generated by HPC for coverage - | LateCC !CostCentreIndex -- ^ Annotated by the one of the prof-last* passes. +data CCFlavour = CafCC -- ^ Auto-generated top-level thunk, they all go into the same bucket + | IndexedCC !IndexedCCFlavour !CostCentreIndex -- ^ Explicitly annotated expression deriving (Eq, Ord, Data) +-- Construct a CC flavour +mkCafFlavour :: CCFlavour +mkCafFlavour = CafCC +mkExprCCFlavour :: CostCentreIndex -> CCFlavour +mkExprCCFlavour idx = IndexedCC ExprCC idx +mkDeclCCFlavour :: CostCentreIndex -> CCFlavour +mkDeclCCFlavour idx = IndexedCC DeclCC idx +mkHpcCCFlavour :: CostCentreIndex -> CCFlavour +mkHpcCCFlavour idx = IndexedCC HpcCC idx +mkLateCCFlavour :: CostCentreIndex -> CCFlavour +mkLateCCFlavour idx = IndexedCC LateCC idx +mkCallerCCFlavour :: CostCentreIndex -> CCFlavour +mkCallerCCFlavour idx = IndexedCC CallerCC idx + -- | Extract the index from a flavour flavourIndex :: CCFlavour -> Int flavourIndex CafCC = 0 -flavourIndex (ExprCC x) = unCostCentreIndex x -flavourIndex (DeclCC x) = unCostCentreIndex x -flavourIndex (HpcCC x) = unCostCentreIndex x -flavourIndex (LateCC x) = unCostCentreIndex x +flavourIndex (IndexedCC _flav x) = unCostCentreIndex x instance Eq CostCentre where c1 == c2 = case c1 `cmpCostCentre` c2 of { EQ -> True; _ -> False } @@ -304,10 +320,13 @@ ppCostCentreLbl (NormalCC {cc_flavour = f, cc_name = n, cc_mod = m}) -- ^ Print the flavour component of a C label ppFlavourLblComponent :: IsLine doc => CCFlavour -> doc ppFlavourLblComponent CafCC = text "CAF" -ppFlavourLblComponent (ExprCC i) = text "EXPR" <> ppIdxLblComponent i -ppFlavourLblComponent (DeclCC i) = text "DECL" <> ppIdxLblComponent i -ppFlavourLblComponent (HpcCC i) = text "HPC" <> ppIdxLblComponent i -ppFlavourLblComponent (LateCC i) = text "LATECC" <> ppIdxLblComponent i +ppFlavourLblComponent (IndexedCC flav i) = + case flav of + ExprCC -> text "EXPR" <> ppIdxLblComponent i + DeclCC -> text "DECL" <> ppIdxLblComponent i + HpcCC -> text "HPC" <> ppIdxLblComponent i + LateCC -> text "LATECC" <> ppIdxLblComponent i + CallerCC -> text "CALLERCC" <> ppIdxLblComponent i {-# SPECIALISE ppFlavourLblComponent :: CCFlavour -> SDoc #-} {-# SPECIALISE ppFlavourLblComponent :: CCFlavour -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable @@ -337,28 +356,18 @@ costCentreSrcSpan = cc_loc instance Binary CCFlavour where put_ bh CafCC = - putByte bh 0 - put_ bh (ExprCC i) = do - putByte bh 1 - put_ bh i - put_ bh (DeclCC i) = do - putByte bh 2 - put_ bh i - put_ bh (HpcCC i) = do - putByte bh 3 - put_ bh i - put_ bh (LateCC i) = do - putByte bh 4 - put_ bh i + putByte bh 0 + put_ bh (IndexedCC flav i) = do + putByte bh 1 + let !flav_index = fromEnum flav + put_ bh flav_index + put_ bh i get bh = do h <- getByte bh case h of 0 -> return CafCC - 1 -> ExprCC <$> get bh - 2 -> DeclCC <$> get bh - 3 -> HpcCC <$> get bh - 4 -> LateCC <$> get bh - _ -> panic "Invalid CCFlavour" + _ -> do + IndexedCC <$> (toEnum <$> get bh) <*> get bh instance Binary CostCentre where put_ bh (NormalCC aa ab ac _ad) = do ===================================== configure.ac ===================================== @@ -934,17 +934,6 @@ AC_CHECK_DECLS([program_invocation_short_name], , , [#define _GNU_SOURCE 1 #include ]) -dnl ** check for mingwex library -AC_CHECK_LIB( - [mingwex], - [closedir], - [AC_SUBST([HaveLibMingwEx],[YES])] [AC_SUBST([CabalMingwex],[True])], - [AC_SUBST([HaveLibMingwEx],[NO])] [AC_SUBST([CabalMingwex],[False])]) - -if test $HaveLibMingwEx = YES ; then - AC_DEFINE([HAVE_MINGWEX], [1], [Define to 1 if you have the mingwex library.]) -fi - dnl ** check for math library dnl Keep that check as early as possible. dnl as we need to know whether we need libm ===================================== hadrian/cfg/system.config.in ===================================== @@ -205,7 +205,6 @@ libnuma-lib-dir = @LibNumaLibDir@ use-lib-dw = @UseLibdw@ use-lib-numa = @UseLibNuma@ -use-lib-mingw-ex = @HaveLibMingwEx@ use-lib-m = @UseLibm@ use-lib-rt = @UseLibrt@ use-lib-dl = @UseLibdl@ ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -35,7 +35,6 @@ data Flag = ArSupportsAtFile | UseLibffiForAdjustors | UseLibdw | UseLibnuma - | UseLibmingwex | UseLibm | UseLibrt | UseLibdl @@ -66,7 +65,6 @@ flag f = do UseLibffiForAdjustors -> "use-libffi-for-adjustors" UseLibdw -> "use-lib-dw" UseLibnuma -> "use-lib-numa" - UseLibmingwex -> "use-lib-mingw-ex" UseLibm -> "use-lib-m" UseLibrt -> "use-lib-rt" UseLibdl -> "use-lib-dl" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -284,8 +284,7 @@ projectVersion = mconcat rtsCabalFlags :: Interpolations rtsCabalFlags = mconcat - [ flag "CabalMingwex" UseLibmingwex - , flag "CabalHaveLibdw" UseLibdw + [ flag "CabalHaveLibdw" UseLibdw , flag "CabalHaveLibm" UseLibm , flag "CabalHaveLibrt" UseLibrt , flag "CabalHaveLibdl" UseLibdl ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -403,8 +403,7 @@ rtsPackageArgs = package rts ? do , builder HsCpp ? pure [ "-DTOP=" ++ show top ] - , builder HsCpp ? flag UseLibdw ? arg "-DUSE_LIBDW" - , builder HsCpp ? flag UseLibmingwex ? arg "-DHAVE_LIBMINGWEX" ] + , builder HsCpp ? flag UseLibdw ? arg "-DUSE_LIBDW" ] -- Compile various performance-critical pieces *without* -fPIC -dynamic -- even when building a shared library. If we don't do this, then the ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -452,7 +452,6 @@ foreign import ccall unsafe "HsBase.h __hscore_fstat" foreign import ccall unsafe "HsBase.h __hscore_lstat" lstat :: CFilePath -> Ptr CStat -> IO CInt - #endif #if defined(js_HOST_ARCH) @@ -592,109 +591,95 @@ foreign import javascript unsafe "(($1,$2,$3_1,$3_2) => { return h$base_c_fcntl_ #else -{- Note: Win32 POSIX functions -Functions that are not part of the POSIX standards were -at some point deprecated by Microsoft. This deprecation -was performed by renaming the functions according to the -C++ ABI Section 17.6.4.3.2b. This was done to free up the -namespace of normal Windows programs since Windows isn't -POSIX compliant anyway. +#if defined(mingw32_HOST_OS) +-- See Note [Windows types] +foreign import capi unsafe "HsBase.h _read" + c_read :: CInt -> Ptr Word8 -> CUInt -> IO CInt -These were working before since the RTS was re-exporting -these symbols under the undeprecated names. This is no longer -being done. See #11223 +-- See Note [Windows types] +foreign import capi safe "HsBase.h _read" + c_safe_read :: CInt -> Ptr Word8 -> CUInt -> IO CInt -See https://msdn.microsoft.com/en-us/library/ms235384.aspx -for more. +foreign import ccall unsafe "HsBase.h _umask" + c_umask :: CMode -> IO CMode -However since we can't hope to get people to support Windows -packages we should support the deprecated names. See #12497 --} -foreign import capi unsafe "unistd.h lseek" - c_lseek :: CInt -> COff -> CInt -> IO COff +-- See Note [Windows types] +foreign import capi unsafe "HsBase.h _write" + c_write :: CInt -> Ptr Word8 -> CUInt -> IO CInt -foreign import ccall unsafe "HsBase.h access" +-- See Note [Windows types] +foreign import capi safe "HsBase.h _write" + c_safe_write :: CInt -> Ptr Word8 -> CUInt -> IO CInt + +foreign import ccall unsafe "HsBase.h _pipe" + c_pipe :: Ptr CInt -> IO CInt + +foreign import capi unsafe "HsBase.h _lseeki64" + c_lseek :: CInt -> Int64 -> CInt -> IO Int64 + +foreign import capi unsafe "HsBase.h _access" c_access :: CString -> CInt -> IO CInt #if !defined(HAVE_CHMOD) c_chmod :: CString -> CMode -> IO CInt -c_chmod _ _ = ioError (ioeSetLocation unsupportedOperation "chmod") +c_chmod _ _ = ioError (ioeSetLocation unsupportedOperation "_chmod") #else -foreign import ccall unsafe "HsBase.h chmod" +foreign import ccall unsafe "HsBase.h _chmod" c_chmod :: CString -> CMode -> IO CInt #endif -foreign import ccall unsafe "HsBase.h close" +foreign import capi unsafe "HsBase.h _close" c_close :: CInt -> IO CInt -foreign import ccall unsafe "HsBase.h creat" +foreign import capi unsafe "HsBase.h _creat" c_creat :: CString -> CMode -> IO CInt #if !defined(HAVE_DUP) c_dup :: CInt -> IO CInt -c_dup _ = ioError (ioeSetLocation unsupportedOperation "dup") +c_dup _ = ioError (ioeSetLocation unsupportedOperation "_dup") c_dup2 :: CInt -> CInt -> IO CInt -c_dup2 _ _ = ioError (ioeSetLocation unsupportedOperation "dup2") +c_dup2 _ _ = ioError (ioeSetLocation unsupportedOperation "_dup2") #else -foreign import ccall unsafe "HsBase.h dup" +foreign import ccall unsafe "HsBase.h _dup" c_dup :: CInt -> IO CInt -foreign import ccall unsafe "HsBase.h dup2" +foreign import ccall unsafe "HsBase.h _dup2" c_dup2 :: CInt -> CInt -> IO CInt #endif -foreign import ccall unsafe "HsBase.h isatty" +foreign import capi unsafe "HsBase.h _isatty" c_isatty :: CInt -> IO CInt -#if defined(mingw32_HOST_OS) --- See Note: Windows types -foreign import capi unsafe "HsBase.h _read" - c_read :: CInt -> Ptr Word8 -> CUInt -> IO CInt - --- See Note: Windows types -foreign import capi safe "HsBase.h _read" - c_safe_read :: CInt -> Ptr Word8 -> CUInt -> IO CInt - -foreign import ccall unsafe "HsBase.h _umask" - c_umask :: CMode -> IO CMode - --- See Note: Windows types -foreign import capi unsafe "HsBase.h _write" - c_write :: CInt -> Ptr Word8 -> CUInt -> IO CInt +foreign import capi unsafe "HsBase.h _unlink" + c_unlink :: CString -> IO CInt --- See Note: Windows types -foreign import capi safe "HsBase.h _write" - c_safe_write :: CInt -> Ptr Word8 -> CUInt -> IO CInt +foreign import capi unsafe "HsBase.h _utime" + c_utime :: CString -> Ptr CUtimbuf -> IO CInt -foreign import ccall unsafe "HsBase.h _pipe" - c_pipe :: Ptr CInt -> IO CInt +foreign import capi unsafe "HsBase.h _getpid" + c_getpid :: IO CPid #else -- We use CAPI as on some OSs (eg. Linux) this is wrapped by a macro -- which redirects to the 64-bit-off_t versions when large file -- support is enabled. --- See Note: Windows types +-- See Note [Windows types] foreign import capi unsafe "HsBase.h read" c_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize --- See Note: Windows types +-- See Note [Windows types] foreign import capi safe "HsBase.h read" c_safe_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize -#if defined(HAVE_UMASK) foreign import ccall unsafe "HsBase.h umask" c_umask :: CMode -> IO CMode -#else -c_umask :: CMode -> IO CMode -c_umask _ = ioError (ioeSetLocation unsupportedOperation "umask") -#endif --- See Note: Windows types +-- See Note [Windows types] foreign import capi unsafe "HsBase.h write" c_write :: CInt -> Ptr Word8 -> CSize -> IO CSsize --- See Note: Windows types +-- See Note [Windows types] foreign import capi safe "HsBase.h write" c_safe_write :: CInt -> Ptr Word8 -> CSize -> IO CSsize @@ -705,8 +690,44 @@ c_pipe _ = ioError (ioeSetLocation unsupportedOperation "pipe") foreign import ccall unsafe "HsBase.h pipe" c_pipe :: Ptr CInt -> IO CInt #endif + +foreign import capi unsafe "unistd.h lseek" + c_lseek :: CInt -> COff -> CInt -> IO COff + +foreign import ccall unsafe "HsBase.h access" + c_access :: CString -> CInt -> IO CInt + +#if !defined(HAVE_CHMOD) +c_chmod :: CString -> CMode -> IO CInt +c_chmod _ _ = ioError (ioeSetLocation unsupportedOperation "chmod") +#else +foreign import ccall unsafe "HsBase.h chmod" + c_chmod :: CString -> CMode -> IO CInt +#endif + +foreign import ccall unsafe "HsBase.h close" + c_close :: CInt -> IO CInt + +foreign import ccall unsafe "HsBase.h creat" + c_creat :: CString -> CMode -> IO CInt + +#if !defined(HAVE_DUP) +c_dup :: CInt -> IO CInt +c_dup _ = ioError (ioeSetLocation unsupportedOperation "dup") + +c_dup2 :: CInt -> CInt -> IO CInt +c_dup2 _ _ = ioError (ioeSetLocation unsupportedOperation "dup2") +#else +foreign import ccall unsafe "HsBase.h dup" + c_dup :: CInt -> IO CInt + +foreign import ccall unsafe "HsBase.h dup2" + c_dup2 :: CInt -> CInt -> IO CInt #endif +foreign import ccall unsafe "HsBase.h isatty" + c_isatty :: CInt -> IO CInt + foreign import ccall unsafe "HsBase.h unlink" c_unlink :: CString -> IO CInt @@ -720,6 +741,7 @@ c_getpid = pure 1 foreign import ccall unsafe "HsBase.h getpid" c_getpid :: IO CPid #endif +#endif #if !defined(js_HOST_ARCH) foreign import ccall unsafe "HsBase.h __hscore_stat" @@ -881,7 +903,8 @@ foreign import capi unsafe "stdio.h value SEEK_END" sEEK_END :: CInt #endif {- -Note: Windows types +Note [Windows types] +~~~~~~~~~~~~~~~~~~~~ Windows' _read and _write have types that differ from POSIX. They take an unsigned int for length and return a signed int where POSIX uses size_t and ===================================== libraries/base/base.cabal ===================================== @@ -397,7 +397,6 @@ Library if os(windows) -- Windows requires some extra libraries for linking because the RTS -- is no longer re-exporting them. - -- mingwex: provides C99 compatibility. libm is a stub on MingW. -- mingw32: Unfortunately required because of a resource leak between -- mingwex and mingw32. the __math_err symbol is defined in -- mingw32 which is required by mingwex. @@ -410,7 +409,7 @@ Library -- advapi32: provides advanced kernel functions extra-libraries: wsock32, user32, shell32, mingw32, kernel32, advapi32, - mingwex, ws2_32, shlwapi, ole32, rpcrt4, ntdll + ws2_32, shlwapi, ole32, rpcrt4, ntdll -- Minimum supported Windows version. -- These numbers can be found at: -- https://msdn.microsoft.com/en-us/library/windows/desktop/aa383745(v=vs.85).aspx ===================================== libraries/base/configure.ac ===================================== @@ -39,7 +39,7 @@ AC_CHECK_LIB([rt], [clock_gettime]) AC_CHECK_FUNCS([clock_gettime]) AC_CHECK_DECLS([CLOCK_PROCESS_CPUTIME_ID], [], [], [[#include ]]) AC_CHECK_FUNCS([getclock getrusage times]) -AC_CHECK_FUNCS([_chsize ftruncate]) +AC_CHECK_FUNCS([_chsize_s ftruncate]) # event-related fun # The line below already defines HAVE_KQUEUE and HAVE_POLL, so technically some of the ===================================== libraries/base/include/HsBase.h ===================================== @@ -280,15 +280,12 @@ __hscore_o_nonblock( void ) INLINE int __hscore_ftruncate( int fd, off_t where ) { -#if defined(HAVE_FTRUNCATE) +#if defined(HAVE__CHSIZE_S) + return _chsize_s(fd,where); +#elif defined(HAVE_FTRUNCATE) return ftruncate(fd,where); -#elif defined(HAVE__CHSIZE) - return _chsize(fd,where); #else -// ToDo: we should use _chsize_s() on Windows which allows a 64-bit -// offset, but it doesn't seem to be available from mingw at this time -// --SDM (01/2008) -#error at least ftruncate or _chsize functions are required to build +#error at least _chsize_s or ftruncate functions are required to build #endif } ===================================== libraries/ghc-prim/ghc-prim.cabal ===================================== @@ -66,15 +66,14 @@ Library if os(windows) -- Windows requires some extra libraries for linking because the RTS -- is no longer re-exporting them (see #11223) - -- msvcrt: standard C library. The RTS will automatically include this, - -- but is added for completeness. - -- mingwex: provides C99 compatibility. libm is a stub on MingW. + -- ucrt: standard C library. The RTS will automatically include this, + -- but is added for completeness. -- mingw32: Unfortunately required because of a resource leak between -- mingwex and mingw32. the __math_err symbol is defined in -- mingw32 which is required by mingwex. -- user32: provides access to apis to modify user components (UI etc) -- on Windows. Required because of mingw32. - extra-libraries: user32, mingw32, mingwex, ucrt + extra-libraries: user32, mingw32, ucrt if os(linux) -- we need libm, but for musl and other's we might need libc, as libm ===================================== mk/get-win32-tarballs.py ===================================== @@ -8,7 +8,7 @@ import argparse import sys from sys import stderr -TARBALL_VERSION = '0.7' +TARBALL_VERSION = '0.8' BASE_URL = "https://downloads.haskell.org/ghc/mingw/{}".format(TARBALL_VERSION) DEST = Path('ghc-tarballs/mingw-w64') ARCHS = ['x86_64', 'sources'] ===================================== rts/Linker.c ===================================== @@ -135,7 +135,7 @@ extern void iconv(); This is to enable lazy loading of symbols. Eager loading is problematic as it means that all symbols must be available, even those which we will never use. This is especially painful on Windows, where the number of - libraries required to link things like mingwex grows to be quite high. + libraries required to link things like QT or WxWidgets grows to be quite high. We proceed through these stages as follows, @@ -193,7 +193,7 @@ extern void iconv(); 1) Dependency chains, if A.o required a .o in libB but A.o isn't required to link then we don't need to load libB. This means the dependency chain for libraries - such as mingw32 and mingwex can be broken down. + such as ucrt can be broken down. 2) The number of duplicate symbols, since now only symbols that are true duplicates will display the error. @@ -226,7 +226,7 @@ static void ghciRemoveSymbolTable(StrHashTable *table, const SymbolName* key, static const char * symbolTypeString (SymType type) { - switch (type) { + switch (type & ~SYM_TYPE_DUP_DISCARD) { case SYM_TYPE_CODE: return "code"; case SYM_TYPE_DATA: return "data"; case SYM_TYPE_INDIRECT_DATA: return "indirect-data"; @@ -275,14 +275,18 @@ int ghciInsertSymbolTable( insertStrHashTable(table, key, pinfo); return 1; } - else if (pinfo->type != type) + else if (pinfo->type ^ type) { - debugBelch("Symbol type mismatch.\n"); - debugBelch("Symbol %s was defined by %" PATH_FMT " to be a %s symbol.\n", - key, obj_name, symbolTypeString(type)); - debugBelch(" yet was defined by %" PATH_FMT " to be a %s symbol.\n", - pinfo->owner ? pinfo->owner->fileName : WSTR(""), - symbolTypeString(pinfo->type)); + /* We were asked to discard the symbol on duplicates, do so quietly. */ + if (!(type & SYM_TYPE_DUP_DISCARD)) + { + debugBelch("Symbol type mismatch.\n"); + debugBelch("Symbol %s was defined by %" PATH_FMT " to be a %s symbol.\n", + key, obj_name, symbolTypeString(type)); + debugBelch(" yet was defined by %" PATH_FMT " to be a %s symbol.\n", + pinfo->owner ? pinfo->owner->fileName : WSTR(""), + symbolTypeString(pinfo->type)); + } return 1; } else if (pinfo->strength == STRENGTH_STRONG) ===================================== rts/LinkerInternals.h ===================================== @@ -54,11 +54,16 @@ typedef struct _Section Section; */ /* What kind of thing a symbol identifies. We need to know this to determine how - * to process overflowing relocations. See Note [Processing overflowed relocations]. */ + * to process overflowing relocations. See Note [Processing overflowed relocations]. + * This is bitfield however only the option SYM_TYPE_DUP_DISCARD can be combined + * with the other values. */ typedef enum _SymType { - SYM_TYPE_CODE, /* the symbol is a function and can be relocated via a jump island */ - SYM_TYPE_DATA, /* the symbol is data */ - SYM_TYPE_INDIRECT_DATA, /* see Note [_iob_func symbol] */ + SYM_TYPE_CODE = 1 << 0, /* the symbol is a function and can be relocated via a jump island */ + SYM_TYPE_DATA = 1 << 1, /* the symbol is data */ + SYM_TYPE_INDIRECT_DATA = 1 << 2, /* see Note [_iob_func symbol] */ + SYM_TYPE_DUP_DISCARD = 1 << 3, /* the symbol is a symbol in a BFD import library + however if a duplicate is found with a mismatching + SymType then discard this one. */ } SymType; ===================================== rts/RtsSymbols.c ===================================== @@ -113,26 +113,6 @@ extern char **environ; * by the RtsSymbols entry. To avoid this we introduce a horrible special case * in `ghciInsertSymbolTable`, ensure that `atexit` is never overridden. */ -/* - * Note [Symbols for MinGW's printf] - * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - * The printf offered by Microsoft's libc implementation, msvcrt, is quite - * incomplete, lacking support for even %ull. Consequently mingw-w64 offers its - * own implementation which we enable. However, to be thread-safe the - * implementation uses _lock_file. This would be fine except msvcrt.dll doesn't - * export _lock_file, only numbered versions do (e.g. msvcrt90.dll). - * - * To work around this mingw-w64 packages a static archive of msvcrt which - * includes their own implementation of _lock_file. However, this means that - * the archive contains things which the dynamic library does not; consequently - * we need to ensure that the runtime linker provides this symbol. - * - * It's all just so terrible. - * - * See also: - * https://sourceforge.net/p/mingw-w64/wiki2/gnu%20printf/ - * https://sourceforge.net/p/mingw-w64/discussion/723797/thread/55520785/ - */ /* Note [_iob_func symbol] * ~~~~~~~~~~~~~~~~~~~~~~~ * Microsoft in VS2013 to VS2015 transition made a backwards incompatible change @@ -170,10 +150,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(_errno)) \ - /* see Note [Symbols for MinGW's printf] */ \ - SymI_HasProto(_lock_file) \ - SymI_HasProto(_unlock_file) \ SymI_HasProto(__mingw_vsnwprintf) \ /* ^^ Need to figure out why this is needed. */ \ /* See Note [_iob_func symbol] */ \ @@ -185,120 +161,8 @@ extern char **environ; /* ^^ Need to figure out why this is needed. */ \ SymI_HasProto(__mingw_vfprintf) \ /* ^^ Need to figure out why this is needed. */ - -#define RTS_MINGW_COMPAT_SYMBOLS \ - SymI_HasProto_deprecated(access) \ - SymI_HasProto_deprecated(cabs) \ - SymI_HasProto_deprecated(cgets) \ - SymI_HasProto_deprecated(chdir) \ - SymI_HasProto_deprecated(chmod) \ - SymI_HasProto_deprecated(chsize) \ - SymI_HasProto_deprecated(close) \ - SymI_HasProto_deprecated(cprintf) \ - SymI_HasProto_deprecated(cputs) \ - SymI_HasProto_deprecated(creat) \ - SymI_HasProto_deprecated(cscanf) \ - SymI_HasProto_deprecated(cwait) \ - SymI_HasProto_deprecated(dup) \ - SymI_HasProto_deprecated(dup2) \ - SymI_HasProto_deprecated(ecvt) \ - SymI_HasProto_deprecated(eof) \ - SymI_HasProto_deprecated(execl) \ - SymI_HasProto_deprecated(execle) \ - SymI_HasProto_deprecated(execlp) \ - SymI_HasProto_deprecated(execlpe) \ - SymI_HasProto_deprecated(execv) \ - SymI_HasProto_deprecated(execve) \ - SymI_HasProto_deprecated(execvp) \ - SymI_HasProto_deprecated(execvpe) \ - SymI_HasProto_deprecated(fcloseall) \ - SymI_HasProto_deprecated(fcvt) \ - SymI_HasProto_deprecated(fdopen) \ - SymI_HasProto_deprecated(fgetchar) \ - SymI_HasProto_deprecated(filelength) \ - SymI_HasProto_deprecated(fileno) \ - SymI_HasProto_deprecated(flushall) \ - SymI_HasProto_deprecated(fputchar) \ - SymI_HasProto_deprecated(gcvt) \ - SymI_HasProto_deprecated(getch) \ - SymI_HasProto_deprecated(getche) \ - SymI_HasProto_deprecated(getcwd) \ - SymI_HasProto_deprecated(getpid) \ - SymI_HasProto_deprecated(getw) \ - SymI_HasProto_deprecated(hypot) \ - SymI_HasProto_deprecated(inp) \ - SymI_HasProto_deprecated(inpw) \ - SymI_HasProto_deprecated(isascii) \ - SymI_HasProto_deprecated(isatty) \ - SymI_HasProto_deprecated(iscsym) \ - SymI_HasProto_deprecated(iscsymf) \ - SymI_HasProto_deprecated(itoa) \ - SymI_HasProto_deprecated(j0) \ - SymI_HasProto_deprecated(j1) \ - SymI_HasProto_deprecated(jn) \ - SymI_HasProto_deprecated(kbhit) \ - SymI_HasProto_deprecated(lfind) \ - SymI_HasProto_deprecated(locking) \ - SymI_HasProto_deprecated(lsearch) \ - SymI_HasProto_deprecated(lseek) \ - SymI_HasProto_deprecated(ltoa) \ - SymI_HasProto_deprecated(memccpy) \ - SymI_HasProto_deprecated(memicmp) \ - SymI_HasProto_deprecated(mkdir) \ - SymI_HasProto_deprecated(mktemp) \ - SymI_HasProto_deprecated(open) \ - SymI_HasProto_deprecated(outp) \ - SymI_HasProto_deprecated(outpw) \ - SymI_HasProto_deprecated(putch) \ - SymI_HasProto_deprecated(putenv) \ - SymI_HasProto_deprecated(putw) \ - SymI_HasProto_deprecated(read) \ - SymI_HasProto_deprecated(rmdir) \ - SymI_HasProto_deprecated(rmtmp) \ - SymI_HasProto_deprecated(setmode) \ - SymI_HasProto_deprecated(sopen) \ - SymI_HasProto_deprecated(spawnl) \ - SymI_HasProto_deprecated(spawnle) \ - SymI_HasProto_deprecated(spawnlp) \ - SymI_HasProto_deprecated(spawnlpe) \ - SymI_HasProto_deprecated(spawnv) \ - SymI_HasProto_deprecated(spawnve) \ - SymI_HasProto_deprecated(spawnvp) \ - SymI_HasProto_deprecated(spawnvpe) \ - SymI_HasProto_deprecated(strcmpi) \ - SymI_HasProto_deprecated(strdup) \ - SymI_HasProto_deprecated(stricmp) \ - SymI_HasProto_deprecated(strlwr) \ - SymI_HasProto_deprecated(strnicmp) \ - SymI_HasProto_deprecated(strnset) \ - SymI_HasProto_deprecated(strrev) \ - SymI_HasProto_deprecated(strset) \ - SymI_HasProto_deprecated(strupr) \ - SymI_HasProto_deprecated(swab) \ - SymI_HasProto_deprecated(tell) \ - SymI_HasProto_deprecated(tempnam) \ - SymI_HasProto_deprecated(toascii) \ - SymI_HasProto_deprecated(tzset) \ - SymI_HasProto_deprecated(ultoa) \ - SymI_HasProto_deprecated(umask) \ - SymI_HasProto_deprecated(ungetch) \ - SymI_HasProto_deprecated(unlink) \ - SymI_HasProto_deprecated(wcsdup) \ - SymI_HasProto_deprecated(wcsicmp) \ - SymI_HasProto_deprecated(wcsicoll) \ - SymI_HasProto_deprecated(wcslwr) \ - SymI_HasProto_deprecated(wcsnicmp) \ - SymI_HasProto_deprecated(wcsnset) \ - SymI_HasProto_deprecated(wcsrev) \ - SymI_HasProto_deprecated(wcsset) \ - SymI_HasProto_deprecated(wcsupr) \ - SymI_HasProto_deprecated(write) \ - SymI_HasProto_deprecated(y0) \ - SymI_HasProto_deprecated(y1) \ - SymI_HasProto_deprecated(yn) #else #define RTS_MINGW_ONLY_SYMBOLS /**/ -#define RTS_MINGW_COMPAT_SYMBOLS /**/ #endif @@ -1121,7 +985,6 @@ extern char **environ; #define SymI_HasProto(vvv) /**/ #define SymI_HasDataProto(vvv) /**/ #define SymI_HasProto_redirect(vvv,xxx,strength,ty) /**/ -#define SymI_HasProto_deprecated(vvv) /**/ RTS_SYMBOLS RTS_RET_SYMBOLS @@ -1139,7 +1002,6 @@ RTS_LIBFFI_SYMBOLS #undef SymI_HasProto #undef SymI_HasDataProto #undef SymI_HasProto_redirect -#undef SymI_HasProto_deprecated #undef SymE_HasProto #undef SymE_HasDataProto #undef SymE_NeedsProto @@ -1165,22 +1027,11 @@ RTS_LIBFFI_SYMBOLS { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \ (void*)(&(xxx)), strength, ty }, -// SymI_HasProto_deprecated allows us to redirect references from their deprecated -// names to the undeprecated ones. e.g. access -> _access. -// We use the hexspeak for unallocated memory 0xBAADF00D to signal the RTS -// that this needs to be loaded from somewhere else. -// These are inserted as weak symbols to prevent us overriding packages that do -// define them, since on Windows these functions shouldn't be in the top level -// namespace, but we have them for POSIX compatibility. -#define SymI_HasProto_deprecated(vvv) \ - { #vvv, (void*)0xBAADF00D, STRENGTH_WEAK, SYM_TYPE_CODE }, - RtsSymbolVal rtsSyms[] = { RTS_SYMBOLS RTS_RET_SYMBOLS RTS_POSIX_ONLY_SYMBOLS RTS_MINGW_ONLY_SYMBOLS - RTS_MINGW_COMPAT_SYMBOLS RTS_DARWIN_ONLY_SYMBOLS RTS_OPENBSD_ONLY_SYMBOLS RTS_LIBGCC_SYMBOLS ===================================== rts/linker/PEi386.c ===================================== @@ -261,6 +261,54 @@ .asciiz "libfoo_data" + Note [GHC Linking model and import libraries] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + The above describes how import libraries work for static linking. + Fundamentally this does not apply to dynamic linking as we do in GHC. + The issue is two-folds: + + 1. In the linking model above it is expected that the .idata sections be + materialized into PLTs during linking. However in GHC we never create + PLTs, but have out own mechanism for this which is the jump island + machinery. This is required for efficiency. For one materializing the + .idata sections would result in wasting pages. We'd use one page for + every ~100 bytes. This is extremely wasteful and also fragments the + memory. Secondly the dynamic linker is lazy. We only perform the final + loading if the symbol is used, however with an import library we can + discard the actual OC immediately after reading it. This prevents us from + keeping ~1k in memory per symbol for no reason. + + 2. GHC itself does not observe symbol visibility correctly during NGC. This + in itself isn't an academic exercise. The issue stems from GHC using one + mechanism for providing two incompatible linking modes: + a) The first mode is generating Haskell shared libraries which are + intended to be used by other Haskell code. This requires us to + export the info, data and closures. For this GHC just re-exports + all symbols. But it doesn't correcly mark data/code. Symbol + visibility is overwritten by telling the linker to export all + symbols. + b) The second code is producing code that's supposed to be call-able + through a C insterface. This in reality does not require the + export of closures and info tables. But also does not require the + inclusion of the RTS inside the DLL. Hover this is done today + because we don't properly have the RTS as a dynamic library. + i.e. GHC does not only export symbols denoted by foreign export. + Also GHC should depend on an RTS library, but at the moment it + cannot because of TNTC is incompatible with dynamic linking. + + These two issues mean that for GHC we need to take a different approach + to handling import libraries. For normal C libraries we have proper + differentiation between CODE and DATA. For GHC produced import libraries + we do not. As such the SYM_TYPE_DUP_DISCARD tells the linker that if a + duplicate symbol is found, and we were going to discard it anyway, just do + so quitely. This works because the RTS symbols themselves are provided by + the currently loaded RTS as built-in symbols. + + Secondly we cannot rely on a text symbol being available. As such we + should only depend on the symbols as defined in the .idata sections, + otherwise we would not be able to correctly link against GHC produced + import libraries. + Note [Memory allocation] ~~~~~~~~~~~~~~~~~~~~~~~~ The loading of an object begins in `preloadObjectFile`, which allocates a buffer, @@ -1658,7 +1706,10 @@ ocGetNames_PEi386 ( ObjectCode* oc ) if ( secNumber != IMAGE_SYM_UNDEFINED && secNumber > 0 && section - && section->kind != SECTIONKIND_BFD_IMPORT_LIBRARY) { + /* Skip all BFD import sections. */ + && section->kind != SECTIONKIND_IMPORT + && section->kind != SECTIONKIND_BFD_IMPORT_LIBRARY + && section->kind != SECTIONKIND_BFD_IMPORT_LIBRARY_HEAD) { /* This symbol is global and defined, viz, exported */ /* for IMAGE_SYMCLASS_EXTERNAL && !IMAGE_SYM_UNDEFINED, @@ -1691,12 +1742,49 @@ ocGetNames_PEi386 ( ObjectCode* oc ) IF_DEBUG(linker_verbose, debugBelch("bss symbol @ %p %u\n", addr, symValue)); } else if (section && section->kind == SECTIONKIND_BFD_IMPORT_LIBRARY) { - setImportSymbol(oc, sname); + /* Disassembly of section .idata$5: + + 0000000000000000 <__imp_Insert>: + ... + 0: IMAGE_REL_AMD64_ADDR32NB .idata$6 + + The first two bytes contain the ordinal of the function + in the format of lowpart highpart. The two bytes combined + for the total range of 16 bits which is the function export limit + of DLLs. See note [GHC Linking model and import libraries]. */ + sname = (SymbolName*)section->start+2; + COFF_symbol* sym = &oc->info->symbols[info->numberOfSymbols-1]; + addr = get_sym_name( getSymShortName (info, sym), oc); + + IF_DEBUG(linker, + debugBelch("addImportSymbol `%s' => `%s'\n", + sname, (char*)addr)); + /* We're going to free the any data associated with the import + library without copying the sections. So we have to duplicate + the symbol name and values before the pointers become invalid. */ + sname = strdup (sname); + addr = strdup (addr); + type = has_code_section ? SYM_TYPE_CODE : SYM_TYPE_DATA; + type |= SYM_TYPE_DUP_DISCARD; + if (!ghciInsertSymbolTable(oc->fileName, symhash, sname, + addr, false, type, oc)) { + releaseOcInfo (oc); + stgFree (oc->image); + oc->image = NULL; + return false; + } + setImportSymbol (oc, sname); + + /* Don't process this oc any further. Just exit. */ + oc->n_symbols = 0; + oc->symbols = NULL; + stgFree (oc->image); + oc->image = NULL; + releaseOcInfo (oc); // There is nothing that we need to resolve in this object since we // will never call the import stubs in its text section oc->status = OBJECT_DONT_RESOLVE; - - IF_DEBUG(linker_verbose, debugBelch("import symbol %s\n", sname)); + return true; } else if (secNumber > 0 && section @@ -2171,21 +2259,7 @@ SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType } else { if (type) *type = pinfo->type; - // If Windows, perform initialization of uninitialized - // Symbols from the C runtime which was loaded above. - // We do this on lookup to prevent the hit when - // The symbol isn't being used. - if (pinfo->value == (void*)0xBAADF00D) - { - char symBuffer[50]; - const char *crt_impl = "ucrtbase"; - sprintf(symBuffer, "_%s", lbl); - static HMODULE crt = NULL; - if (!crt) crt = GetModuleHandle(crt_impl); - pinfo->value = GetProcAddress(crt, symBuffer); - return pinfo->value; - } - else if (pinfo && pinfo->owner && isSymbolImport (pinfo->owner, lbl)) + if (pinfo && pinfo->owner && isSymbolImport (pinfo->owner, lbl)) { /* See Note [BFD import library]. */ HINSTANCE dllInstance = (HINSTANCE)lookupDependentSymbol(pinfo->value, dependent, type); ===================================== rts/rts.cabal.in ===================================== @@ -39,8 +39,6 @@ flag need-pthread default: @CabalNeedLibpthread@ flag libbfd default: @CabalHaveLibbfd@ -flag mingwex - default: @CabalMingwex@ flag need-atomic default: @CabalNeedLibatomic@ flag libdw @@ -83,7 +81,6 @@ library exposed: True exposed-modules: - if os(ghcjs) include-dirs: include @@ -209,8 +206,6 @@ library if flag(libbfd) -- for debugging extra-libraries: bfd iberty - if flag(mingwex) - extra-libraries: mingwex if flag(libdw) -- for backtraces extra-libraries: elf dw ===================================== testsuite/tests/ghci/linking/dyn/Makefile ===================================== @@ -88,10 +88,6 @@ compile_libAB_dyn: .PHONY: compile_libAS_impl_gcc compile_libAS_impl_gcc: - rm -rf bin_impl_gcc - mkdir bin_impl_gcc - '$(TEST_HC)' $(MY_TEST_HC_OPTS) -odir "bin_impl_gcc" -shared A.c -o "bin_impl_gcc/$(call DLL,ASimpL)" - mv bin_impl_gcc/libASimpL.dll.a bin_impl_gcc/libASx.dll.a echo "main" | '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) T11072.hs -lASx -L./bin_impl_gcc .PHONY: compile_libAS_impl_msvc ===================================== testsuite/tests/ghci/linking/dyn/all.T ===================================== @@ -41,9 +41,9 @@ test('T10458', extra_hc_opts('-L"$PWD/T10458dir" -lAS')], ghci_script, ['T10458.script']) -test('T11072gcc', [extra_files(['A.c', 'T11072.hs']), - expect_broken(18718), - unless(doing_ghci, skip), unless(opsys('mingw32'), skip)], +test('T11072gcc', [extra_files(['A.c', 'T11072.hs', 'bin_impl_gcc/']), + unless(doing_ghci, skip), unless(opsys('mingw32'), skip), + unless(arch('x86_64'), skip)], makefile_test, ['compile_libAS_impl_gcc']) test('T11072msvc', [extra_files(['A.c', 'T11072.hs', 'libAS.def', 'i686/', 'x86_64/']), ===================================== testsuite/tests/ghci/linking/dyn/bin_impl_gcc/ASimpL.dll ===================================== Binary files /dev/null and b/testsuite/tests/ghci/linking/dyn/bin_impl_gcc/ASimpL.dll differ ===================================== testsuite/tests/ghci/linking/dyn/bin_impl_gcc/libASx.dll.a ===================================== Binary files /dev/null and b/testsuite/tests/ghci/linking/dyn/bin_impl_gcc/libASx.dll.a differ ===================================== testsuite/tests/rts/all.T ===================================== @@ -411,7 +411,7 @@ test('T10296b', [only_ways(['threaded2'])], compile_and_run, ['']) test('numa001', [ extra_run_opts('8'), unless(unregisterised(), extra_ways(['debug_numa'])) ] , compile_and_run, ['']) -test('T12497', [ unless(opsys('mingw32'), skip) +test('T12497', [ unless(opsys('mingw32'), skip), expect_broken(22694) ], makefile_test, ['T12497']) ===================================== utils/genapply/Main.hs ===================================== @@ -1,9 +1,6 @@ {-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-unused-matches #-} -{-# OPTIONS_GHC -fno-warn-unused-binds #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# OPTIONS_GHC -fno-warn-overlapping-patterns #-} -{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} -- The above warning suppression flags are a temporary kludge. -- While working on this module you are encouraged to remove it and fix @@ -124,7 +121,7 @@ assignRegs Int) -- Sp of left-over args assignRegs regstatus sp args = assign sp args (availableRegs regstatus) [] -assign sp [] regs doc = (doc, [], sp) +assign sp [] _regs doc = (doc, [], sp) assign sp (V : args) regs doc = assign sp args regs doc assign sp (arg : args) regs doc = case findAvailableReg arg regs of @@ -248,7 +245,7 @@ stackCheck -> Doc stackCheck regstatus args args_in_regs fun_info_label (prof_sp, norm_sp) = let - (reg_locs, leftovers, sp_offset) = assignRegs regstatus 1 args + (reg_locs, _leftovers, sp_offset) = assignRegs regstatus 1 args cmp_sp n | n > 0 = @@ -287,7 +284,7 @@ genMkPAP :: RegStatus -- Register status -> Doc -- info label -> Bool -- Is a function -> (Doc, StackUsage) -genMkPAP regstatus macro jump live ticker disamb +genMkPAP regstatus macro jump live _ticker disamb no_load_regs -- don't load argument regs before jumping args_in_regs -- arguments are already in regs is_pap args all_args_size fun_info_label @@ -391,6 +388,7 @@ genMkPAP regstatus macro jump live ticker disamb (reg,off) <- extra_reg_locs ] adj = case extra_reg_locs of (reg, fst_off):_ -> fst_off + [] -> error "Impossible: genapply.hs : No extra register locations" size = snd (last adj_reg_locs) + 1 doc = @@ -470,7 +468,7 @@ genMkPAP regstatus macro jump live ticker disamb (larger_arity_doc, larger_arity_stack) = (doc, stack) where -- offsets in case we need to save regs: - (reg_locs, leftovers, sp_offset) + (reg_locs, _leftovers, sp_offset) = assignRegs regstatus stk_args_slow_offset args -- BUILD_PAP assumes args start at offset 1 @@ -823,7 +821,7 @@ genApplyFast regstatus args = False{-reg apply-} True{-args in regs-} False{-not a PAP-} args all_args_size fun_info_label {- tag stmt -}True - (reg_locs, leftovers, sp_offset) = assignRegs regstatus 1 args + (reg_locs, _leftovers, sp_offset) = assignRegs regstatus 1 args stack_usage = maxStack [fun_stack, (sp_offset,sp_offset)] in View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9a29a44bef08eafdcb97079f6361260102501fc4...aad5f12922489e80e990bdc7c858c1effbb916ac -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9a29a44bef08eafdcb97079f6361260102501fc4...aad5f12922489e80e990bdc7c858c1effbb916ac You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 16:24:03 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Fri, 03 Feb 2023 11:24:03 -0500 Subject: [Git][ghc/ghc][wip/T20749] 29 commits: ghc-the-library: Retain cafs in both static in dynamic builds. Message-ID: <63dd35238e1b5_1108fe193a739867295e@gitlab.mail> Sebastian Graf pushed to branch wip/T20749 at Glasgow Haskell Compiler / GHC Commits: 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - bd6c3038 by Sebastian Graf at 2023-02-03T17:23:56+01:00 Make DataCon workers strict in strict fields (#20749) This patch tweaks `exprIsConApp_maybe`, `exprIsHNF` and frieds, and Demand Analysis so that they exploit and maintain strictness of DataCon workers. See `Note [Strict fields in Core]` for details. Very little needed to change, and it puts field seq insertion done by Tag Inference into a new perspective: That of *implementing* strict field semantics. Before Tag Inference, DataCon workers are strict. Afterwards they are effectively lazy and field seqs happen around use sites. History has shown that there is no other way to guarantee taggedness and thus the STG Strict Field Invariant. Unfortunately, T21392 does no longer reproduce after this patch, so I marked it as "not broken" in order to track whether we regress again in the future. Fixes #20749, the satisfying conclusion of an annoying saga (cf. the ideas in #21497 and #22475). - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - cabal.project-reinstall - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Reg.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/07e6142fb15bac5a4059635c70639bc104e67d6b...bd6c3038f4bf3a48177c831535baf0928f503dfd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/07e6142fb15bac5a4059635c70639bc104e67d6b...bd6c3038f4bf3a48177c831535baf0928f503dfd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 19:07:54 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 03 Feb 2023 14:07:54 -0500 Subject: [Git][ghc/ghc][master] 3 commits: Windows: Remove mingwex dependency Message-ID: <63dd5b8ab3090_1108fec035f07194d5@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - 22 changed files: - .gitlab-ci.yml - configure.ac - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Packages.hs - libraries/base/System/Posix/Internals.hs - libraries/base/base.cabal - libraries/base/configure.ac - libraries/base/include/HsBase.h - libraries/ghc-prim/ghc-prim.cabal - mk/get-win32-tarballs.py - rts/Linker.c - rts/LinkerInternals.h - rts/RtsSymbols.c - rts/linker/PEi386.c - rts/rts.cabal.in - testsuite/tests/ghci/linking/dyn/Makefile - testsuite/tests/ghci/linking/dyn/all.T - + testsuite/tests/ghci/linking/dyn/bin_impl_gcc/ASimpL.dll - + testsuite/tests/ghci/linking/dyn/bin_impl_gcc/libASx.dll.a - testsuite/tests/rts/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -6,7 +6,7 @@ variables: # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. - CACHE_REV: 9 + CACHE_REV: 10 # Disable shallow clones; they break our linting rules GIT_DEPTH: 0 ===================================== configure.ac ===================================== @@ -934,17 +934,6 @@ AC_CHECK_DECLS([program_invocation_short_name], , , [#define _GNU_SOURCE 1 #include ]) -dnl ** check for mingwex library -AC_CHECK_LIB( - [mingwex], - [closedir], - [AC_SUBST([HaveLibMingwEx],[YES])] [AC_SUBST([CabalMingwex],[True])], - [AC_SUBST([HaveLibMingwEx],[NO])] [AC_SUBST([CabalMingwex],[False])]) - -if test $HaveLibMingwEx = YES ; then - AC_DEFINE([HAVE_MINGWEX], [1], [Define to 1 if you have the mingwex library.]) -fi - dnl ** check for math library dnl Keep that check as early as possible. dnl as we need to know whether we need libm ===================================== hadrian/cfg/system.config.in ===================================== @@ -205,7 +205,6 @@ libnuma-lib-dir = @LibNumaLibDir@ use-lib-dw = @UseLibdw@ use-lib-numa = @UseLibNuma@ -use-lib-mingw-ex = @HaveLibMingwEx@ use-lib-m = @UseLibm@ use-lib-rt = @UseLibrt@ use-lib-dl = @UseLibdl@ ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -35,7 +35,6 @@ data Flag = ArSupportsAtFile | UseLibffiForAdjustors | UseLibdw | UseLibnuma - | UseLibmingwex | UseLibm | UseLibrt | UseLibdl @@ -66,7 +65,6 @@ flag f = do UseLibffiForAdjustors -> "use-libffi-for-adjustors" UseLibdw -> "use-lib-dw" UseLibnuma -> "use-lib-numa" - UseLibmingwex -> "use-lib-mingw-ex" UseLibm -> "use-lib-m" UseLibrt -> "use-lib-rt" UseLibdl -> "use-lib-dl" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -284,8 +284,7 @@ projectVersion = mconcat rtsCabalFlags :: Interpolations rtsCabalFlags = mconcat - [ flag "CabalMingwex" UseLibmingwex - , flag "CabalHaveLibdw" UseLibdw + [ flag "CabalHaveLibdw" UseLibdw , flag "CabalHaveLibm" UseLibm , flag "CabalHaveLibrt" UseLibrt , flag "CabalHaveLibdl" UseLibdl ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -403,8 +403,7 @@ rtsPackageArgs = package rts ? do , builder HsCpp ? pure [ "-DTOP=" ++ show top ] - , builder HsCpp ? flag UseLibdw ? arg "-DUSE_LIBDW" - , builder HsCpp ? flag UseLibmingwex ? arg "-DHAVE_LIBMINGWEX" ] + , builder HsCpp ? flag UseLibdw ? arg "-DUSE_LIBDW" ] -- Compile various performance-critical pieces *without* -fPIC -dynamic -- even when building a shared library. If we don't do this, then the ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -452,7 +452,6 @@ foreign import ccall unsafe "HsBase.h __hscore_fstat" foreign import ccall unsafe "HsBase.h __hscore_lstat" lstat :: CFilePath -> Ptr CStat -> IO CInt - #endif #if defined(js_HOST_ARCH) @@ -592,109 +591,95 @@ foreign import javascript unsafe "(($1,$2,$3_1,$3_2) => { return h$base_c_fcntl_ #else -{- Note: Win32 POSIX functions -Functions that are not part of the POSIX standards were -at some point deprecated by Microsoft. This deprecation -was performed by renaming the functions according to the -C++ ABI Section 17.6.4.3.2b. This was done to free up the -namespace of normal Windows programs since Windows isn't -POSIX compliant anyway. +#if defined(mingw32_HOST_OS) +-- See Note [Windows types] +foreign import capi unsafe "HsBase.h _read" + c_read :: CInt -> Ptr Word8 -> CUInt -> IO CInt -These were working before since the RTS was re-exporting -these symbols under the undeprecated names. This is no longer -being done. See #11223 +-- See Note [Windows types] +foreign import capi safe "HsBase.h _read" + c_safe_read :: CInt -> Ptr Word8 -> CUInt -> IO CInt -See https://msdn.microsoft.com/en-us/library/ms235384.aspx -for more. +foreign import ccall unsafe "HsBase.h _umask" + c_umask :: CMode -> IO CMode -However since we can't hope to get people to support Windows -packages we should support the deprecated names. See #12497 --} -foreign import capi unsafe "unistd.h lseek" - c_lseek :: CInt -> COff -> CInt -> IO COff +-- See Note [Windows types] +foreign import capi unsafe "HsBase.h _write" + c_write :: CInt -> Ptr Word8 -> CUInt -> IO CInt -foreign import ccall unsafe "HsBase.h access" +-- See Note [Windows types] +foreign import capi safe "HsBase.h _write" + c_safe_write :: CInt -> Ptr Word8 -> CUInt -> IO CInt + +foreign import ccall unsafe "HsBase.h _pipe" + c_pipe :: Ptr CInt -> IO CInt + +foreign import capi unsafe "HsBase.h _lseeki64" + c_lseek :: CInt -> Int64 -> CInt -> IO Int64 + +foreign import capi unsafe "HsBase.h _access" c_access :: CString -> CInt -> IO CInt #if !defined(HAVE_CHMOD) c_chmod :: CString -> CMode -> IO CInt -c_chmod _ _ = ioError (ioeSetLocation unsupportedOperation "chmod") +c_chmod _ _ = ioError (ioeSetLocation unsupportedOperation "_chmod") #else -foreign import ccall unsafe "HsBase.h chmod" +foreign import ccall unsafe "HsBase.h _chmod" c_chmod :: CString -> CMode -> IO CInt #endif -foreign import ccall unsafe "HsBase.h close" +foreign import capi unsafe "HsBase.h _close" c_close :: CInt -> IO CInt -foreign import ccall unsafe "HsBase.h creat" +foreign import capi unsafe "HsBase.h _creat" c_creat :: CString -> CMode -> IO CInt #if !defined(HAVE_DUP) c_dup :: CInt -> IO CInt -c_dup _ = ioError (ioeSetLocation unsupportedOperation "dup") +c_dup _ = ioError (ioeSetLocation unsupportedOperation "_dup") c_dup2 :: CInt -> CInt -> IO CInt -c_dup2 _ _ = ioError (ioeSetLocation unsupportedOperation "dup2") +c_dup2 _ _ = ioError (ioeSetLocation unsupportedOperation "_dup2") #else -foreign import ccall unsafe "HsBase.h dup" +foreign import ccall unsafe "HsBase.h _dup" c_dup :: CInt -> IO CInt -foreign import ccall unsafe "HsBase.h dup2" +foreign import ccall unsafe "HsBase.h _dup2" c_dup2 :: CInt -> CInt -> IO CInt #endif -foreign import ccall unsafe "HsBase.h isatty" +foreign import capi unsafe "HsBase.h _isatty" c_isatty :: CInt -> IO CInt -#if defined(mingw32_HOST_OS) --- See Note: Windows types -foreign import capi unsafe "HsBase.h _read" - c_read :: CInt -> Ptr Word8 -> CUInt -> IO CInt - --- See Note: Windows types -foreign import capi safe "HsBase.h _read" - c_safe_read :: CInt -> Ptr Word8 -> CUInt -> IO CInt - -foreign import ccall unsafe "HsBase.h _umask" - c_umask :: CMode -> IO CMode - --- See Note: Windows types -foreign import capi unsafe "HsBase.h _write" - c_write :: CInt -> Ptr Word8 -> CUInt -> IO CInt +foreign import capi unsafe "HsBase.h _unlink" + c_unlink :: CString -> IO CInt --- See Note: Windows types -foreign import capi safe "HsBase.h _write" - c_safe_write :: CInt -> Ptr Word8 -> CUInt -> IO CInt +foreign import capi unsafe "HsBase.h _utime" + c_utime :: CString -> Ptr CUtimbuf -> IO CInt -foreign import ccall unsafe "HsBase.h _pipe" - c_pipe :: Ptr CInt -> IO CInt +foreign import capi unsafe "HsBase.h _getpid" + c_getpid :: IO CPid #else -- We use CAPI as on some OSs (eg. Linux) this is wrapped by a macro -- which redirects to the 64-bit-off_t versions when large file -- support is enabled. --- See Note: Windows types +-- See Note [Windows types] foreign import capi unsafe "HsBase.h read" c_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize --- See Note: Windows types +-- See Note [Windows types] foreign import capi safe "HsBase.h read" c_safe_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize -#if defined(HAVE_UMASK) foreign import ccall unsafe "HsBase.h umask" c_umask :: CMode -> IO CMode -#else -c_umask :: CMode -> IO CMode -c_umask _ = ioError (ioeSetLocation unsupportedOperation "umask") -#endif --- See Note: Windows types +-- See Note [Windows types] foreign import capi unsafe "HsBase.h write" c_write :: CInt -> Ptr Word8 -> CSize -> IO CSsize --- See Note: Windows types +-- See Note [Windows types] foreign import capi safe "HsBase.h write" c_safe_write :: CInt -> Ptr Word8 -> CSize -> IO CSsize @@ -705,8 +690,44 @@ c_pipe _ = ioError (ioeSetLocation unsupportedOperation "pipe") foreign import ccall unsafe "HsBase.h pipe" c_pipe :: Ptr CInt -> IO CInt #endif + +foreign import capi unsafe "unistd.h lseek" + c_lseek :: CInt -> COff -> CInt -> IO COff + +foreign import ccall unsafe "HsBase.h access" + c_access :: CString -> CInt -> IO CInt + +#if !defined(HAVE_CHMOD) +c_chmod :: CString -> CMode -> IO CInt +c_chmod _ _ = ioError (ioeSetLocation unsupportedOperation "chmod") +#else +foreign import ccall unsafe "HsBase.h chmod" + c_chmod :: CString -> CMode -> IO CInt +#endif + +foreign import ccall unsafe "HsBase.h close" + c_close :: CInt -> IO CInt + +foreign import ccall unsafe "HsBase.h creat" + c_creat :: CString -> CMode -> IO CInt + +#if !defined(HAVE_DUP) +c_dup :: CInt -> IO CInt +c_dup _ = ioError (ioeSetLocation unsupportedOperation "dup") + +c_dup2 :: CInt -> CInt -> IO CInt +c_dup2 _ _ = ioError (ioeSetLocation unsupportedOperation "dup2") +#else +foreign import ccall unsafe "HsBase.h dup" + c_dup :: CInt -> IO CInt + +foreign import ccall unsafe "HsBase.h dup2" + c_dup2 :: CInt -> CInt -> IO CInt #endif +foreign import ccall unsafe "HsBase.h isatty" + c_isatty :: CInt -> IO CInt + foreign import ccall unsafe "HsBase.h unlink" c_unlink :: CString -> IO CInt @@ -720,6 +741,7 @@ c_getpid = pure 1 foreign import ccall unsafe "HsBase.h getpid" c_getpid :: IO CPid #endif +#endif #if !defined(js_HOST_ARCH) foreign import ccall unsafe "HsBase.h __hscore_stat" @@ -881,7 +903,8 @@ foreign import capi unsafe "stdio.h value SEEK_END" sEEK_END :: CInt #endif {- -Note: Windows types +Note [Windows types] +~~~~~~~~~~~~~~~~~~~~ Windows' _read and _write have types that differ from POSIX. They take an unsigned int for length and return a signed int where POSIX uses size_t and ===================================== libraries/base/base.cabal ===================================== @@ -397,7 +397,6 @@ Library if os(windows) -- Windows requires some extra libraries for linking because the RTS -- is no longer re-exporting them. - -- mingwex: provides C99 compatibility. libm is a stub on MingW. -- mingw32: Unfortunately required because of a resource leak between -- mingwex and mingw32. the __math_err symbol is defined in -- mingw32 which is required by mingwex. @@ -410,7 +409,7 @@ Library -- advapi32: provides advanced kernel functions extra-libraries: wsock32, user32, shell32, mingw32, kernel32, advapi32, - mingwex, ws2_32, shlwapi, ole32, rpcrt4, ntdll + ws2_32, shlwapi, ole32, rpcrt4, ntdll -- Minimum supported Windows version. -- These numbers can be found at: -- https://msdn.microsoft.com/en-us/library/windows/desktop/aa383745(v=vs.85).aspx ===================================== libraries/base/configure.ac ===================================== @@ -39,7 +39,7 @@ AC_CHECK_LIB([rt], [clock_gettime]) AC_CHECK_FUNCS([clock_gettime]) AC_CHECK_DECLS([CLOCK_PROCESS_CPUTIME_ID], [], [], [[#include ]]) AC_CHECK_FUNCS([getclock getrusage times]) -AC_CHECK_FUNCS([_chsize ftruncate]) +AC_CHECK_FUNCS([_chsize_s ftruncate]) # event-related fun # The line below already defines HAVE_KQUEUE and HAVE_POLL, so technically some of the ===================================== libraries/base/include/HsBase.h ===================================== @@ -280,15 +280,12 @@ __hscore_o_nonblock( void ) INLINE int __hscore_ftruncate( int fd, off_t where ) { -#if defined(HAVE_FTRUNCATE) +#if defined(HAVE__CHSIZE_S) + return _chsize_s(fd,where); +#elif defined(HAVE_FTRUNCATE) return ftruncate(fd,where); -#elif defined(HAVE__CHSIZE) - return _chsize(fd,where); #else -// ToDo: we should use _chsize_s() on Windows which allows a 64-bit -// offset, but it doesn't seem to be available from mingw at this time -// --SDM (01/2008) -#error at least ftruncate or _chsize functions are required to build +#error at least _chsize_s or ftruncate functions are required to build #endif } ===================================== libraries/ghc-prim/ghc-prim.cabal ===================================== @@ -66,15 +66,14 @@ Library if os(windows) -- Windows requires some extra libraries for linking because the RTS -- is no longer re-exporting them (see #11223) - -- msvcrt: standard C library. The RTS will automatically include this, - -- but is added for completeness. - -- mingwex: provides C99 compatibility. libm is a stub on MingW. + -- ucrt: standard C library. The RTS will automatically include this, + -- but is added for completeness. -- mingw32: Unfortunately required because of a resource leak between -- mingwex and mingw32. the __math_err symbol is defined in -- mingw32 which is required by mingwex. -- user32: provides access to apis to modify user components (UI etc) -- on Windows. Required because of mingw32. - extra-libraries: user32, mingw32, mingwex, ucrt + extra-libraries: user32, mingw32, ucrt if os(linux) -- we need libm, but for musl and other's we might need libc, as libm ===================================== mk/get-win32-tarballs.py ===================================== @@ -8,7 +8,7 @@ import argparse import sys from sys import stderr -TARBALL_VERSION = '0.7' +TARBALL_VERSION = '0.8' BASE_URL = "https://downloads.haskell.org/ghc/mingw/{}".format(TARBALL_VERSION) DEST = Path('ghc-tarballs/mingw-w64') ARCHS = ['x86_64', 'sources'] ===================================== rts/Linker.c ===================================== @@ -135,7 +135,7 @@ extern void iconv(); This is to enable lazy loading of symbols. Eager loading is problematic as it means that all symbols must be available, even those which we will never use. This is especially painful on Windows, where the number of - libraries required to link things like mingwex grows to be quite high. + libraries required to link things like QT or WxWidgets grows to be quite high. We proceed through these stages as follows, @@ -193,7 +193,7 @@ extern void iconv(); 1) Dependency chains, if A.o required a .o in libB but A.o isn't required to link then we don't need to load libB. This means the dependency chain for libraries - such as mingw32 and mingwex can be broken down. + such as ucrt can be broken down. 2) The number of duplicate symbols, since now only symbols that are true duplicates will display the error. @@ -226,7 +226,7 @@ static void ghciRemoveSymbolTable(StrHashTable *table, const SymbolName* key, static const char * symbolTypeString (SymType type) { - switch (type) { + switch (type & ~SYM_TYPE_DUP_DISCARD) { case SYM_TYPE_CODE: return "code"; case SYM_TYPE_DATA: return "data"; case SYM_TYPE_INDIRECT_DATA: return "indirect-data"; @@ -275,14 +275,18 @@ int ghciInsertSymbolTable( insertStrHashTable(table, key, pinfo); return 1; } - else if (pinfo->type != type) + else if (pinfo->type ^ type) { - debugBelch("Symbol type mismatch.\n"); - debugBelch("Symbol %s was defined by %" PATH_FMT " to be a %s symbol.\n", - key, obj_name, symbolTypeString(type)); - debugBelch(" yet was defined by %" PATH_FMT " to be a %s symbol.\n", - pinfo->owner ? pinfo->owner->fileName : WSTR(""), - symbolTypeString(pinfo->type)); + /* We were asked to discard the symbol on duplicates, do so quietly. */ + if (!(type & SYM_TYPE_DUP_DISCARD)) + { + debugBelch("Symbol type mismatch.\n"); + debugBelch("Symbol %s was defined by %" PATH_FMT " to be a %s symbol.\n", + key, obj_name, symbolTypeString(type)); + debugBelch(" yet was defined by %" PATH_FMT " to be a %s symbol.\n", + pinfo->owner ? pinfo->owner->fileName : WSTR(""), + symbolTypeString(pinfo->type)); + } return 1; } else if (pinfo->strength == STRENGTH_STRONG) ===================================== rts/LinkerInternals.h ===================================== @@ -54,11 +54,16 @@ typedef struct _Section Section; */ /* What kind of thing a symbol identifies. We need to know this to determine how - * to process overflowing relocations. See Note [Processing overflowed relocations]. */ + * to process overflowing relocations. See Note [Processing overflowed relocations]. + * This is bitfield however only the option SYM_TYPE_DUP_DISCARD can be combined + * with the other values. */ typedef enum _SymType { - SYM_TYPE_CODE, /* the symbol is a function and can be relocated via a jump island */ - SYM_TYPE_DATA, /* the symbol is data */ - SYM_TYPE_INDIRECT_DATA, /* see Note [_iob_func symbol] */ + SYM_TYPE_CODE = 1 << 0, /* the symbol is a function and can be relocated via a jump island */ + SYM_TYPE_DATA = 1 << 1, /* the symbol is data */ + SYM_TYPE_INDIRECT_DATA = 1 << 2, /* see Note [_iob_func symbol] */ + SYM_TYPE_DUP_DISCARD = 1 << 3, /* the symbol is a symbol in a BFD import library + however if a duplicate is found with a mismatching + SymType then discard this one. */ } SymType; ===================================== rts/RtsSymbols.c ===================================== @@ -113,26 +113,6 @@ extern char **environ; * by the RtsSymbols entry. To avoid this we introduce a horrible special case * in `ghciInsertSymbolTable`, ensure that `atexit` is never overridden. */ -/* - * Note [Symbols for MinGW's printf] - * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - * The printf offered by Microsoft's libc implementation, msvcrt, is quite - * incomplete, lacking support for even %ull. Consequently mingw-w64 offers its - * own implementation which we enable. However, to be thread-safe the - * implementation uses _lock_file. This would be fine except msvcrt.dll doesn't - * export _lock_file, only numbered versions do (e.g. msvcrt90.dll). - * - * To work around this mingw-w64 packages a static archive of msvcrt which - * includes their own implementation of _lock_file. However, this means that - * the archive contains things which the dynamic library does not; consequently - * we need to ensure that the runtime linker provides this symbol. - * - * It's all just so terrible. - * - * See also: - * https://sourceforge.net/p/mingw-w64/wiki2/gnu%20printf/ - * https://sourceforge.net/p/mingw-w64/discussion/723797/thread/55520785/ - */ /* Note [_iob_func symbol] * ~~~~~~~~~~~~~~~~~~~~~~~ * Microsoft in VS2013 to VS2015 transition made a backwards incompatible change @@ -170,10 +150,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(_errno)) \ - /* see Note [Symbols for MinGW's printf] */ \ - SymI_HasProto(_lock_file) \ - SymI_HasProto(_unlock_file) \ SymI_HasProto(__mingw_vsnwprintf) \ /* ^^ Need to figure out why this is needed. */ \ /* See Note [_iob_func symbol] */ \ @@ -185,120 +161,8 @@ extern char **environ; /* ^^ Need to figure out why this is needed. */ \ SymI_HasProto(__mingw_vfprintf) \ /* ^^ Need to figure out why this is needed. */ - -#define RTS_MINGW_COMPAT_SYMBOLS \ - SymI_HasProto_deprecated(access) \ - SymI_HasProto_deprecated(cabs) \ - SymI_HasProto_deprecated(cgets) \ - SymI_HasProto_deprecated(chdir) \ - SymI_HasProto_deprecated(chmod) \ - SymI_HasProto_deprecated(chsize) \ - SymI_HasProto_deprecated(close) \ - SymI_HasProto_deprecated(cprintf) \ - SymI_HasProto_deprecated(cputs) \ - SymI_HasProto_deprecated(creat) \ - SymI_HasProto_deprecated(cscanf) \ - SymI_HasProto_deprecated(cwait) \ - SymI_HasProto_deprecated(dup) \ - SymI_HasProto_deprecated(dup2) \ - SymI_HasProto_deprecated(ecvt) \ - SymI_HasProto_deprecated(eof) \ - SymI_HasProto_deprecated(execl) \ - SymI_HasProto_deprecated(execle) \ - SymI_HasProto_deprecated(execlp) \ - SymI_HasProto_deprecated(execlpe) \ - SymI_HasProto_deprecated(execv) \ - SymI_HasProto_deprecated(execve) \ - SymI_HasProto_deprecated(execvp) \ - SymI_HasProto_deprecated(execvpe) \ - SymI_HasProto_deprecated(fcloseall) \ - SymI_HasProto_deprecated(fcvt) \ - SymI_HasProto_deprecated(fdopen) \ - SymI_HasProto_deprecated(fgetchar) \ - SymI_HasProto_deprecated(filelength) \ - SymI_HasProto_deprecated(fileno) \ - SymI_HasProto_deprecated(flushall) \ - SymI_HasProto_deprecated(fputchar) \ - SymI_HasProto_deprecated(gcvt) \ - SymI_HasProto_deprecated(getch) \ - SymI_HasProto_deprecated(getche) \ - SymI_HasProto_deprecated(getcwd) \ - SymI_HasProto_deprecated(getpid) \ - SymI_HasProto_deprecated(getw) \ - SymI_HasProto_deprecated(hypot) \ - SymI_HasProto_deprecated(inp) \ - SymI_HasProto_deprecated(inpw) \ - SymI_HasProto_deprecated(isascii) \ - SymI_HasProto_deprecated(isatty) \ - SymI_HasProto_deprecated(iscsym) \ - SymI_HasProto_deprecated(iscsymf) \ - SymI_HasProto_deprecated(itoa) \ - SymI_HasProto_deprecated(j0) \ - SymI_HasProto_deprecated(j1) \ - SymI_HasProto_deprecated(jn) \ - SymI_HasProto_deprecated(kbhit) \ - SymI_HasProto_deprecated(lfind) \ - SymI_HasProto_deprecated(locking) \ - SymI_HasProto_deprecated(lsearch) \ - SymI_HasProto_deprecated(lseek) \ - SymI_HasProto_deprecated(ltoa) \ - SymI_HasProto_deprecated(memccpy) \ - SymI_HasProto_deprecated(memicmp) \ - SymI_HasProto_deprecated(mkdir) \ - SymI_HasProto_deprecated(mktemp) \ - SymI_HasProto_deprecated(open) \ - SymI_HasProto_deprecated(outp) \ - SymI_HasProto_deprecated(outpw) \ - SymI_HasProto_deprecated(putch) \ - SymI_HasProto_deprecated(putenv) \ - SymI_HasProto_deprecated(putw) \ - SymI_HasProto_deprecated(read) \ - SymI_HasProto_deprecated(rmdir) \ - SymI_HasProto_deprecated(rmtmp) \ - SymI_HasProto_deprecated(setmode) \ - SymI_HasProto_deprecated(sopen) \ - SymI_HasProto_deprecated(spawnl) \ - SymI_HasProto_deprecated(spawnle) \ - SymI_HasProto_deprecated(spawnlp) \ - SymI_HasProto_deprecated(spawnlpe) \ - SymI_HasProto_deprecated(spawnv) \ - SymI_HasProto_deprecated(spawnve) \ - SymI_HasProto_deprecated(spawnvp) \ - SymI_HasProto_deprecated(spawnvpe) \ - SymI_HasProto_deprecated(strcmpi) \ - SymI_HasProto_deprecated(strdup) \ - SymI_HasProto_deprecated(stricmp) \ - SymI_HasProto_deprecated(strlwr) \ - SymI_HasProto_deprecated(strnicmp) \ - SymI_HasProto_deprecated(strnset) \ - SymI_HasProto_deprecated(strrev) \ - SymI_HasProto_deprecated(strset) \ - SymI_HasProto_deprecated(strupr) \ - SymI_HasProto_deprecated(swab) \ - SymI_HasProto_deprecated(tell) \ - SymI_HasProto_deprecated(tempnam) \ - SymI_HasProto_deprecated(toascii) \ - SymI_HasProto_deprecated(tzset) \ - SymI_HasProto_deprecated(ultoa) \ - SymI_HasProto_deprecated(umask) \ - SymI_HasProto_deprecated(ungetch) \ - SymI_HasProto_deprecated(unlink) \ - SymI_HasProto_deprecated(wcsdup) \ - SymI_HasProto_deprecated(wcsicmp) \ - SymI_HasProto_deprecated(wcsicoll) \ - SymI_HasProto_deprecated(wcslwr) \ - SymI_HasProto_deprecated(wcsnicmp) \ - SymI_HasProto_deprecated(wcsnset) \ - SymI_HasProto_deprecated(wcsrev) \ - SymI_HasProto_deprecated(wcsset) \ - SymI_HasProto_deprecated(wcsupr) \ - SymI_HasProto_deprecated(write) \ - SymI_HasProto_deprecated(y0) \ - SymI_HasProto_deprecated(y1) \ - SymI_HasProto_deprecated(yn) #else #define RTS_MINGW_ONLY_SYMBOLS /**/ -#define RTS_MINGW_COMPAT_SYMBOLS /**/ #endif @@ -1121,7 +985,6 @@ extern char **environ; #define SymI_HasProto(vvv) /**/ #define SymI_HasDataProto(vvv) /**/ #define SymI_HasProto_redirect(vvv,xxx,strength,ty) /**/ -#define SymI_HasProto_deprecated(vvv) /**/ RTS_SYMBOLS RTS_RET_SYMBOLS @@ -1139,7 +1002,6 @@ RTS_LIBFFI_SYMBOLS #undef SymI_HasProto #undef SymI_HasDataProto #undef SymI_HasProto_redirect -#undef SymI_HasProto_deprecated #undef SymE_HasProto #undef SymE_HasDataProto #undef SymE_NeedsProto @@ -1165,22 +1027,11 @@ RTS_LIBFFI_SYMBOLS { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \ (void*)(&(xxx)), strength, ty }, -// SymI_HasProto_deprecated allows us to redirect references from their deprecated -// names to the undeprecated ones. e.g. access -> _access. -// We use the hexspeak for unallocated memory 0xBAADF00D to signal the RTS -// that this needs to be loaded from somewhere else. -// These are inserted as weak symbols to prevent us overriding packages that do -// define them, since on Windows these functions shouldn't be in the top level -// namespace, but we have them for POSIX compatibility. -#define SymI_HasProto_deprecated(vvv) \ - { #vvv, (void*)0xBAADF00D, STRENGTH_WEAK, SYM_TYPE_CODE }, - RtsSymbolVal rtsSyms[] = { RTS_SYMBOLS RTS_RET_SYMBOLS RTS_POSIX_ONLY_SYMBOLS RTS_MINGW_ONLY_SYMBOLS - RTS_MINGW_COMPAT_SYMBOLS RTS_DARWIN_ONLY_SYMBOLS RTS_OPENBSD_ONLY_SYMBOLS RTS_LIBGCC_SYMBOLS ===================================== rts/linker/PEi386.c ===================================== @@ -261,6 +261,54 @@ .asciiz "libfoo_data" + Note [GHC Linking model and import libraries] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + The above describes how import libraries work for static linking. + Fundamentally this does not apply to dynamic linking as we do in GHC. + The issue is two-folds: + + 1. In the linking model above it is expected that the .idata sections be + materialized into PLTs during linking. However in GHC we never create + PLTs, but have out own mechanism for this which is the jump island + machinery. This is required for efficiency. For one materializing the + .idata sections would result in wasting pages. We'd use one page for + every ~100 bytes. This is extremely wasteful and also fragments the + memory. Secondly the dynamic linker is lazy. We only perform the final + loading if the symbol is used, however with an import library we can + discard the actual OC immediately after reading it. This prevents us from + keeping ~1k in memory per symbol for no reason. + + 2. GHC itself does not observe symbol visibility correctly during NGC. This + in itself isn't an academic exercise. The issue stems from GHC using one + mechanism for providing two incompatible linking modes: + a) The first mode is generating Haskell shared libraries which are + intended to be used by other Haskell code. This requires us to + export the info, data and closures. For this GHC just re-exports + all symbols. But it doesn't correcly mark data/code. Symbol + visibility is overwritten by telling the linker to export all + symbols. + b) The second code is producing code that's supposed to be call-able + through a C insterface. This in reality does not require the + export of closures and info tables. But also does not require the + inclusion of the RTS inside the DLL. Hover this is done today + because we don't properly have the RTS as a dynamic library. + i.e. GHC does not only export symbols denoted by foreign export. + Also GHC should depend on an RTS library, but at the moment it + cannot because of TNTC is incompatible with dynamic linking. + + These two issues mean that for GHC we need to take a different approach + to handling import libraries. For normal C libraries we have proper + differentiation between CODE and DATA. For GHC produced import libraries + we do not. As such the SYM_TYPE_DUP_DISCARD tells the linker that if a + duplicate symbol is found, and we were going to discard it anyway, just do + so quitely. This works because the RTS symbols themselves are provided by + the currently loaded RTS as built-in symbols. + + Secondly we cannot rely on a text symbol being available. As such we + should only depend on the symbols as defined in the .idata sections, + otherwise we would not be able to correctly link against GHC produced + import libraries. + Note [Memory allocation] ~~~~~~~~~~~~~~~~~~~~~~~~ The loading of an object begins in `preloadObjectFile`, which allocates a buffer, @@ -1658,7 +1706,10 @@ ocGetNames_PEi386 ( ObjectCode* oc ) if ( secNumber != IMAGE_SYM_UNDEFINED && secNumber > 0 && section - && section->kind != SECTIONKIND_BFD_IMPORT_LIBRARY) { + /* Skip all BFD import sections. */ + && section->kind != SECTIONKIND_IMPORT + && section->kind != SECTIONKIND_BFD_IMPORT_LIBRARY + && section->kind != SECTIONKIND_BFD_IMPORT_LIBRARY_HEAD) { /* This symbol is global and defined, viz, exported */ /* for IMAGE_SYMCLASS_EXTERNAL && !IMAGE_SYM_UNDEFINED, @@ -1691,12 +1742,49 @@ ocGetNames_PEi386 ( ObjectCode* oc ) IF_DEBUG(linker_verbose, debugBelch("bss symbol @ %p %u\n", addr, symValue)); } else if (section && section->kind == SECTIONKIND_BFD_IMPORT_LIBRARY) { - setImportSymbol(oc, sname); + /* Disassembly of section .idata$5: + + 0000000000000000 <__imp_Insert>: + ... + 0: IMAGE_REL_AMD64_ADDR32NB .idata$6 + + The first two bytes contain the ordinal of the function + in the format of lowpart highpart. The two bytes combined + for the total range of 16 bits which is the function export limit + of DLLs. See note [GHC Linking model and import libraries]. */ + sname = (SymbolName*)section->start+2; + COFF_symbol* sym = &oc->info->symbols[info->numberOfSymbols-1]; + addr = get_sym_name( getSymShortName (info, sym), oc); + + IF_DEBUG(linker, + debugBelch("addImportSymbol `%s' => `%s'\n", + sname, (char*)addr)); + /* We're going to free the any data associated with the import + library without copying the sections. So we have to duplicate + the symbol name and values before the pointers become invalid. */ + sname = strdup (sname); + addr = strdup (addr); + type = has_code_section ? SYM_TYPE_CODE : SYM_TYPE_DATA; + type |= SYM_TYPE_DUP_DISCARD; + if (!ghciInsertSymbolTable(oc->fileName, symhash, sname, + addr, false, type, oc)) { + releaseOcInfo (oc); + stgFree (oc->image); + oc->image = NULL; + return false; + } + setImportSymbol (oc, sname); + + /* Don't process this oc any further. Just exit. */ + oc->n_symbols = 0; + oc->symbols = NULL; + stgFree (oc->image); + oc->image = NULL; + releaseOcInfo (oc); // There is nothing that we need to resolve in this object since we // will never call the import stubs in its text section oc->status = OBJECT_DONT_RESOLVE; - - IF_DEBUG(linker_verbose, debugBelch("import symbol %s\n", sname)); + return true; } else if (secNumber > 0 && section @@ -2171,21 +2259,7 @@ SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType } else { if (type) *type = pinfo->type; - // If Windows, perform initialization of uninitialized - // Symbols from the C runtime which was loaded above. - // We do this on lookup to prevent the hit when - // The symbol isn't being used. - if (pinfo->value == (void*)0xBAADF00D) - { - char symBuffer[50]; - const char *crt_impl = "ucrtbase"; - sprintf(symBuffer, "_%s", lbl); - static HMODULE crt = NULL; - if (!crt) crt = GetModuleHandle(crt_impl); - pinfo->value = GetProcAddress(crt, symBuffer); - return pinfo->value; - } - else if (pinfo && pinfo->owner && isSymbolImport (pinfo->owner, lbl)) + if (pinfo && pinfo->owner && isSymbolImport (pinfo->owner, lbl)) { /* See Note [BFD import library]. */ HINSTANCE dllInstance = (HINSTANCE)lookupDependentSymbol(pinfo->value, dependent, type); ===================================== rts/rts.cabal.in ===================================== @@ -39,8 +39,6 @@ flag need-pthread default: @CabalNeedLibpthread@ flag libbfd default: @CabalHaveLibbfd@ -flag mingwex - default: @CabalMingwex@ flag need-atomic default: @CabalNeedLibatomic@ flag libdw @@ -83,7 +81,6 @@ library exposed: True exposed-modules: - if os(ghcjs) include-dirs: include @@ -209,8 +206,6 @@ library if flag(libbfd) -- for debugging extra-libraries: bfd iberty - if flag(mingwex) - extra-libraries: mingwex if flag(libdw) -- for backtraces extra-libraries: elf dw ===================================== testsuite/tests/ghci/linking/dyn/Makefile ===================================== @@ -88,10 +88,6 @@ compile_libAB_dyn: .PHONY: compile_libAS_impl_gcc compile_libAS_impl_gcc: - rm -rf bin_impl_gcc - mkdir bin_impl_gcc - '$(TEST_HC)' $(MY_TEST_HC_OPTS) -odir "bin_impl_gcc" -shared A.c -o "bin_impl_gcc/$(call DLL,ASimpL)" - mv bin_impl_gcc/libASimpL.dll.a bin_impl_gcc/libASx.dll.a echo "main" | '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) T11072.hs -lASx -L./bin_impl_gcc .PHONY: compile_libAS_impl_msvc ===================================== testsuite/tests/ghci/linking/dyn/all.T ===================================== @@ -41,9 +41,9 @@ test('T10458', extra_hc_opts('-L"$PWD/T10458dir" -lAS')], ghci_script, ['T10458.script']) -test('T11072gcc', [extra_files(['A.c', 'T11072.hs']), - expect_broken(18718), - unless(doing_ghci, skip), unless(opsys('mingw32'), skip)], +test('T11072gcc', [extra_files(['A.c', 'T11072.hs', 'bin_impl_gcc/']), + unless(doing_ghci, skip), unless(opsys('mingw32'), skip), + unless(arch('x86_64'), skip)], makefile_test, ['compile_libAS_impl_gcc']) test('T11072msvc', [extra_files(['A.c', 'T11072.hs', 'libAS.def', 'i686/', 'x86_64/']), ===================================== testsuite/tests/ghci/linking/dyn/bin_impl_gcc/ASimpL.dll ===================================== Binary files /dev/null and b/testsuite/tests/ghci/linking/dyn/bin_impl_gcc/ASimpL.dll differ ===================================== testsuite/tests/ghci/linking/dyn/bin_impl_gcc/libASx.dll.a ===================================== Binary files /dev/null and b/testsuite/tests/ghci/linking/dyn/bin_impl_gcc/libASx.dll.a differ ===================================== testsuite/tests/rts/all.T ===================================== @@ -411,7 +411,7 @@ test('T10296b', [only_ways(['threaded2'])], compile_and_run, ['']) test('numa001', [ extra_run_opts('8'), unless(unregisterised(), extra_ways(['debug_numa'])) ] , compile_and_run, ['']) -test('T12497', [ unless(opsys('mingw32'), skip) +test('T12497', [ unless(opsys('mingw32'), skip), expect_broken(22694) ], makefile_test, ['T12497']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8feb93013cf6f093e025c9e9a3213ae1fa0f73a0...b2bb3e62275cc1d9e00a2d5ed511843192133ed5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8feb93013cf6f093e025c9e9a3213ae1fa0f73a0...b2bb3e62275cc1d9e00a2d5ed511843192133ed5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 19:08:27 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 03 Feb 2023 14:08:27 -0500 Subject: [Git][ghc/ghc][master] Fix CallerCC potentially shadowing other cost centres. Message-ID: <63dd5bab46f51_1108fe12881c08723087@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - 6 changed files: - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Types/CostCentre.hs Changes: ===================================== compiler/GHC/Core/LateCC.hs ===================================== @@ -142,7 +142,7 @@ initLateCCState :: LateCCState initLateCCState = LateCCState newCostCentreState mempty getCCFlavour :: FastString -> M CCFlavour -getCCFlavour name = LateCC <$> getCCIndex' name +getCCFlavour name = mkLateCCFlavour <$> getCCIndex' name getCCIndex' :: FastString -> M CostCentreIndex getCCIndex' name = do ===================================== compiler/GHC/Core/Opt/CallerCC.hs ===================================== @@ -84,7 +84,7 @@ doExpr env e@(Var v) span = case revParents env of top:_ -> nameSrcSpan $ varName top _ -> noSrcSpan - cc = NormalCC (ExprCC ccIdx) ccName (thisModule env) span + cc = NormalCC (mkExprCCFlavour ccIdx) ccName (thisModule env) span tick :: CoreTickish tick = ProfNote cc count True pure $ Tick tick e ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -538,7 +538,7 @@ ds_prag_expr (HsPragSCC _ cc) expr = do mod_name <- getModule count <- goptM Opt_ProfCountEntries let nm = sl_fs cc - flavour <- ExprCC <$> getCCIndexDsM nm + flavour <- mkExprCCFlavour <$> getCCIndexDsM nm Tick (ProfNote (mkUserCC nm mod_name (getLocA expr) flavour) count True) <$> dsLExpr expr else dsLExpr expr ===================================== compiler/GHC/HsToCore/Ticks.hs ===================================== @@ -1189,7 +1189,7 @@ mkTickish boxLabel countEntries topOnly pos fvs decl_path = do ProfNotes -> do let nm = mkFastString cc_name - flavour <- HpcCC <$> getCCIndexM nm + flavour <- mkHpcCCFlavour <$> getCCIndexM nm let cc = mkUserCC nm (this_mod env) pos flavour count = countEntries && tte_countEntries env return $ ProfNote cc count True{-scopes-} ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -28,7 +28,7 @@ import {-# SOURCE #-} GHC.Tc.Gen.Expr ( tcCheckMonoExpr ) import {-# SOURCE #-} GHC.Tc.TyCl.PatSyn ( tcPatSynDecl, tcPatSynBuilderBind ) import GHC.Types.Tickish (CoreTickish, GenTickish (..)) -import GHC.Types.CostCentre (mkUserCC, CCFlavour(DeclCC)) +import GHC.Types.CostCentre (mkUserCC, mkDeclCCFlavour) import GHC.Driver.Session import GHC.Data.FastString import GHC.Hs @@ -677,7 +677,7 @@ funBindTicks loc fun_id mod sigs = getOccFS (Var.varName fun_id) cc_name = concatFS [moduleNameFS (moduleName mod), fsLit ".", cc_str] = do - flavour <- DeclCC <$> getCCIndexTcM cc_name + flavour <- mkDeclCCFlavour <$> getCCIndexTcM cc_name let cc = mkUserCC cc_name mod loc flavour return [ProfNote cc True True] | otherwise ===================================== compiler/GHC/Types/CostCentre.hs ===================================== @@ -1,7 +1,9 @@ {-# LANGUAGE DeriveDataTypeable #-} module GHC.Types.CostCentre ( - CostCentre(..), CcName, CCFlavour(..), - -- All abstract except to friend: ParseIface.y + -- All abstract except to friend: ParseIface.y + CostCentre(..), CcName, CCFlavour, + mkCafFlavour, mkExprCCFlavour, mkDeclCCFlavour, mkHpcCCFlavour, + mkLateCCFlavour, mkCallerCCFlavour, pprCostCentre, CostCentreStack, @@ -33,7 +35,6 @@ import GHC.Utils.Outputable import GHC.Types.SrcLoc import GHC.Data.FastString import GHC.Types.CostCentre.State -import GHC.Utils.Panic.Plain import Data.Data @@ -66,24 +67,39 @@ data CostCentre type CcName = FastString +data IndexedCCFlavour + = ExprCC -- ^ Explicitly annotated expression + | DeclCC -- ^ Explicitly annotated declaration + | HpcCC -- ^ Generated by HPC for coverage + | LateCC -- ^ Annotated by the one of the prof-last* passes. + | CallerCC -- ^ Annotated by the one of the prof-last* passes. + deriving (Eq,Ord,Data,Enum) -- | The flavour of a cost centre. -- -- Index fields represent 0-based indices giving source-code ordering of -- centres with the same module, name, and flavour. -data CCFlavour = CafCC -- ^ Auto-generated top-level thunk - | ExprCC !CostCentreIndex -- ^ Explicitly annotated expression - | DeclCC !CostCentreIndex -- ^ Explicitly annotated declaration - | HpcCC !CostCentreIndex -- ^ Generated by HPC for coverage - | LateCC !CostCentreIndex -- ^ Annotated by the one of the prof-last* passes. +data CCFlavour = CafCC -- ^ Auto-generated top-level thunk, they all go into the same bucket + | IndexedCC !IndexedCCFlavour !CostCentreIndex -- ^ Explicitly annotated expression deriving (Eq, Ord, Data) +-- Construct a CC flavour +mkCafFlavour :: CCFlavour +mkCafFlavour = CafCC +mkExprCCFlavour :: CostCentreIndex -> CCFlavour +mkExprCCFlavour idx = IndexedCC ExprCC idx +mkDeclCCFlavour :: CostCentreIndex -> CCFlavour +mkDeclCCFlavour idx = IndexedCC DeclCC idx +mkHpcCCFlavour :: CostCentreIndex -> CCFlavour +mkHpcCCFlavour idx = IndexedCC HpcCC idx +mkLateCCFlavour :: CostCentreIndex -> CCFlavour +mkLateCCFlavour idx = IndexedCC LateCC idx +mkCallerCCFlavour :: CostCentreIndex -> CCFlavour +mkCallerCCFlavour idx = IndexedCC CallerCC idx + -- | Extract the index from a flavour flavourIndex :: CCFlavour -> Int flavourIndex CafCC = 0 -flavourIndex (ExprCC x) = unCostCentreIndex x -flavourIndex (DeclCC x) = unCostCentreIndex x -flavourIndex (HpcCC x) = unCostCentreIndex x -flavourIndex (LateCC x) = unCostCentreIndex x +flavourIndex (IndexedCC _flav x) = unCostCentreIndex x instance Eq CostCentre where c1 == c2 = case c1 `cmpCostCentre` c2 of { EQ -> True; _ -> False } @@ -304,10 +320,13 @@ ppCostCentreLbl (NormalCC {cc_flavour = f, cc_name = n, cc_mod = m}) -- ^ Print the flavour component of a C label ppFlavourLblComponent :: IsLine doc => CCFlavour -> doc ppFlavourLblComponent CafCC = text "CAF" -ppFlavourLblComponent (ExprCC i) = text "EXPR" <> ppIdxLblComponent i -ppFlavourLblComponent (DeclCC i) = text "DECL" <> ppIdxLblComponent i -ppFlavourLblComponent (HpcCC i) = text "HPC" <> ppIdxLblComponent i -ppFlavourLblComponent (LateCC i) = text "LATECC" <> ppIdxLblComponent i +ppFlavourLblComponent (IndexedCC flav i) = + case flav of + ExprCC -> text "EXPR" <> ppIdxLblComponent i + DeclCC -> text "DECL" <> ppIdxLblComponent i + HpcCC -> text "HPC" <> ppIdxLblComponent i + LateCC -> text "LATECC" <> ppIdxLblComponent i + CallerCC -> text "CALLERCC" <> ppIdxLblComponent i {-# SPECIALISE ppFlavourLblComponent :: CCFlavour -> SDoc #-} {-# SPECIALISE ppFlavourLblComponent :: CCFlavour -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable @@ -337,28 +356,18 @@ costCentreSrcSpan = cc_loc instance Binary CCFlavour where put_ bh CafCC = - putByte bh 0 - put_ bh (ExprCC i) = do - putByte bh 1 - put_ bh i - put_ bh (DeclCC i) = do - putByte bh 2 - put_ bh i - put_ bh (HpcCC i) = do - putByte bh 3 - put_ bh i - put_ bh (LateCC i) = do - putByte bh 4 - put_ bh i + putByte bh 0 + put_ bh (IndexedCC flav i) = do + putByte bh 1 + let !flav_index = fromEnum flav + put_ bh flav_index + put_ bh i get bh = do h <- getByte bh case h of 0 -> return CafCC - 1 -> ExprCC <$> get bh - 2 -> DeclCC <$> get bh - 3 -> HpcCC <$> get bh - 4 -> LateCC <$> get bh - _ -> panic "Invalid CCFlavour" + _ -> do + IndexedCC <$> (toEnum <$> get bh) <*> get bh instance Binary CostCentre where put_ bh (NormalCC aa ab ac _ad) = do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bf3f88a1a5b23bdf304baca473c3ee797c5f86bd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bf3f88a1a5b23bdf304baca473c3ee797c5f86bd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 19:09:04 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 03 Feb 2023 14:09:04 -0500 Subject: [Git][ghc/ghc][master] Disable several ignore-warning flags in genapply. Message-ID: <63dd5bd0cfc32_1108fe193a73987265cf@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 1 changed file: - utils/genapply/Main.hs Changes: ===================================== utils/genapply/Main.hs ===================================== @@ -1,9 +1,6 @@ {-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-unused-matches #-} -{-# OPTIONS_GHC -fno-warn-unused-binds #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# OPTIONS_GHC -fno-warn-overlapping-patterns #-} -{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} -- The above warning suppression flags are a temporary kludge. -- While working on this module you are encouraged to remove it and fix @@ -124,7 +121,7 @@ assignRegs Int) -- Sp of left-over args assignRegs regstatus sp args = assign sp args (availableRegs regstatus) [] -assign sp [] regs doc = (doc, [], sp) +assign sp [] _regs doc = (doc, [], sp) assign sp (V : args) regs doc = assign sp args regs doc assign sp (arg : args) regs doc = case findAvailableReg arg regs of @@ -248,7 +245,7 @@ stackCheck -> Doc stackCheck regstatus args args_in_regs fun_info_label (prof_sp, norm_sp) = let - (reg_locs, leftovers, sp_offset) = assignRegs regstatus 1 args + (reg_locs, _leftovers, sp_offset) = assignRegs regstatus 1 args cmp_sp n | n > 0 = @@ -287,7 +284,7 @@ genMkPAP :: RegStatus -- Register status -> Doc -- info label -> Bool -- Is a function -> (Doc, StackUsage) -genMkPAP regstatus macro jump live ticker disamb +genMkPAP regstatus macro jump live _ticker disamb no_load_regs -- don't load argument regs before jumping args_in_regs -- arguments are already in regs is_pap args all_args_size fun_info_label @@ -391,6 +388,7 @@ genMkPAP regstatus macro jump live ticker disamb (reg,off) <- extra_reg_locs ] adj = case extra_reg_locs of (reg, fst_off):_ -> fst_off + [] -> error "Impossible: genapply.hs : No extra register locations" size = snd (last adj_reg_locs) + 1 doc = @@ -470,7 +468,7 @@ genMkPAP regstatus macro jump live ticker disamb (larger_arity_doc, larger_arity_stack) = (doc, stack) where -- offsets in case we need to save regs: - (reg_locs, leftovers, sp_offset) + (reg_locs, _leftovers, sp_offset) = assignRegs regstatus stk_args_slow_offset args -- BUILD_PAP assumes args start at offset 1 @@ -823,7 +821,7 @@ genApplyFast regstatus args = False{-reg apply-} True{-args in regs-} False{-not a PAP-} args all_args_size fun_info_label {- tag stmt -}True - (reg_locs, leftovers, sp_offset) = assignRegs regstatus 1 args + (reg_locs, _leftovers, sp_offset) = assignRegs regstatus 1 args stack_usage = maxStack [fun_stack, (sp_offset,sp_offset)] in View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/faea4bcdf4e71120a5480530fb1879e4439ed512 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/faea4bcdf4e71120a5480530fb1879e4439ed512 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 21:06:58 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Fri, 03 Feb 2023 16:06:58 -0500 Subject: [Git][ghc/ghc][wip/t21766] 21 commits: Improve treatment of type applications in patterns Message-ID: <63dd777214b50_1108fe5260c748819@gitlab.mail> Finley McIlwaine pushed to branch wip/t21766 at Glasgow Haskell Compiler / GHC Commits: 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - f99fc567 by Finley McIlwaine at 2023-02-03T11:04:57-07:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - 740d9d77 by Finley McIlwaine at 2023-02-03T11:04:57-07:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - 356baae5 by Finley McIlwaine at 2023-02-03T11:04:57-07:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - eeb8f15f by Finley McIlwaine at 2023-02-03T11:04:57-07:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - e02f1948 by Finley McIlwaine at 2023-02-03T12:31:53-07:00 Add note describing IPE data compression See ticket #21766 - - - - - 1f21acb7 by Finley McIlwaine at 2023-02-03T14:04:46-07:00 Make IPE tests compatible with new layout IPE data compression requires a new layout for the IPE buffer list entries. This commit makes sure the IPE test field names are consistent with the actual fields of IpeBufferEntry and IpeBufferListNode. See ticket #21766. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/CmmToLlvm/Mangler.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Types/Var/Env.hs - compiler/ghc.cabal.in - configure.ac - docs/users_guide/9.6.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/rewrite_rules.rst - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Packages.hs - libraries/base/GHC/IO/Handle/Types.hs - libraries/base/GHC/Stats.hsc - libraries/base/tests/Concurrent/all.T - libraries/base/tests/IO/T12010/test.T - libraries/base/tests/all.T - libraries/containers The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fcd266f53e1d9273bd1e7d4881884d2c0633dc4b...1f21acb7e4277bd2efd960279e9177a9c81503ab -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fcd266f53e1d9273bd1e7d4881884d2c0633dc4b...1f21acb7e4277bd2efd960279e9177a9c81503ab You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 21:09:31 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Fri, 03 Feb 2023 16:09:31 -0500 Subject: [Git][ghc/ghc][wip/t21766] 11 commits: Windows: Remove mingwex dependency Message-ID: <63dd780b53221_1108fe52648749357@gitlab.mail> Finley McIlwaine pushed to branch wip/t21766 at Glasgow Haskell Compiler / GHC Commits: de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 948b0225 by Finley McIlwaine at 2023-02-03T14:08:03-07:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - 9b0fe9b1 by Finley McIlwaine at 2023-02-03T14:09:05-07:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - 91960603 by Finley McIlwaine at 2023-02-03T14:09:13-07:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - 8383387c by Finley McIlwaine at 2023-02-03T14:09:13-07:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - 9b5d66ea by Finley McIlwaine at 2023-02-03T14:09:13-07:00 Add note describing IPE data compression See ticket #21766 - - - - - 8db447d7 by Finley McIlwaine at 2023-02-03T14:09:13-07:00 Make IPE tests compatible with new layout IPE data compression requires a new layout for the IPE buffer list entries. This commit makes sure the IPE test field names are consistent with the actual fields of IpeBufferEntry and IpeBufferListNode. See ticket #21766. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Types/CostCentre.hs - compiler/ghc.cabal.in - configure.ac - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Packages.hs - libraries/base/System/Posix/Internals.hs - libraries/base/base.cabal - libraries/base/configure.ac - libraries/base/include/HsBase.h - libraries/ghc-prim/ghc-prim.cabal - m4/fp_find_libnuma.m4 - + m4/fp_find_libzstd.m4 - mk/get-win32-tarballs.py - rts/IPE.c - rts/Linker.c - rts/LinkerInternals.h - rts/RtsSymbols.c - rts/include/rts/IPE.h - rts/linker/PEi386.c - rts/rts.cabal.in The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1f21acb7e4277bd2efd960279e9177a9c81503ab...8db447d78f3b3ec737aee927fe0458b8e8da3271 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1f21acb7e4277bd2efd960279e9177a9c81503ab...8db447d78f3b3ec737aee927fe0458b8e8da3271 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 3 21:56:58 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Fri, 03 Feb 2023 16:56:58 -0500 Subject: [Git][ghc/ghc][wip/t21766] Make IPE tests compatible with new layout Message-ID: <63dd832a60415_1108fe5260c751816@gitlab.mail> Finley McIlwaine pushed to branch wip/t21766 at Glasgow Haskell Compiler / GHC Commits: df06f7ef by Finley McIlwaine at 2023-02-03T14:55:38-07:00 Make IPE tests compatible with new layout IPE data compression requires a new layout for the IPE buffer list entries. This commit makes sure the IPE test field names are consistent with the actual fields of IpeBufferEntry and IpeBufferListNode. See ticket #21766. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. - - - - - 6 changed files: - compiler/GHC/StgToCmm/InfoTableProv.hs - rts/include/rts/IPE.h - testsuite/tests/rts/ipe/ipeEventLog_fromMap.c - testsuite/tests/rts/ipe/ipeMap.c - testsuite/tests/rts/ipe/ipe_lib.c - testsuite/tests/rts/ipe/ipe_lib.h Changes: ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -3,10 +3,14 @@ module GHC.StgToCmm.InfoTableProv (emitIpeBufferListNode) where import Foreign + +#if defined(HAVE_LIBZSTD) import Foreign.C.Types +import qualified Data.ByteString.Internal as BSI +import GHC.IO (unsafePerformIO) +#endif import GHC.Data.FastString (fastStringToShortText) -import GHC.IO (unsafePerformIO) import GHC.Prelude import GHC.Platform import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile) @@ -26,7 +30,6 @@ import Control.Monad.Trans.State.Strict import qualified Data.ByteString as BS import qualified Data.ByteString.Builder as BSB -import qualified Data.ByteString.Internal as BSI import qualified Data.ByteString.Lazy as BSL import qualified Data.Map.Strict as M @@ -90,17 +93,16 @@ emitIpeBufferListNode this_mod ents = do uncompressed_strings = getStringTableStrings strtab strings_bytes :: BS.ByteString - strings_bytes = - if do_compress == 1 then - compress defaultCompressionLevel uncompressed_strings - else - uncompressed_strings + strings_bytes = compress defaultCompressionLevel uncompressed_strings strings :: [CmmStatic] strings = [CmmString strings_bytes] + entries_bytes :: BS.ByteString + entries_bytes = toIpeBufferEntries cg_ipes + entries :: [CmmStatic] - entries = toIpeBufferEntries cg_ipes + entries = [CmmString entries_bytes] ipe_buffer_lbl :: CLabel ipe_buffer_lbl = mkIPELabel this_mod @@ -111,7 +113,7 @@ emitIpeBufferListNode this_mod ents = do zeroCLit platform -- 'compressed' field - , int $ do_compress + , int do_compress -- 'count' field , int $ length cg_ipes @@ -123,13 +125,13 @@ emitIpeBufferListNode this_mod ents = do , CmmLabel entries_lbl -- 'entries_size' field - , int (length cg_ipes * 8 * 32) + , int $ BS.length entries_bytes -- 'string_table' field , CmmLabel strings_lbl -- 'string_table_size' field - , int (BS.length strings_bytes) + , int $ BS.length strings_bytes ] -- Emit the list of info table pointers @@ -153,21 +155,16 @@ emitIpeBufferListNode this_mod ents = do (CmmStaticsRaw ipe_buffer_lbl ipe_buffer_node) -- | Emit the fields of an IpeBufferEntry struct for each entry in a given list. --- The fields are converted to a bytestring, compressed, and then emitted as a --- string. If compression is not enabled, the compression step is simply --- @id at . +-- The fields are converted to a bytestring and compressed. If compression is +-- not enabled, the compression step is simply @id at . toIpeBufferEntries :: [CgInfoProvEnt] -- ^ List of IPE buffer entries - -> [CmmStatic] + -> BS.ByteString toIpeBufferEntries cg_ipes = - [ CmmString - . compress defaultCompressionLevel + compress defaultCompressionLevel . BSL.toStrict . BSB.toLazyByteString . mconcat - $ map (mconcat . map (BSB.word32BE) . to_ipe_buf_ent) cg_ipes - ] + $ map (mconcat . map BSB.word32BE . to_ipe_buf_ent) cg_ipes where - int32 n = CmmStaticLit $ CmmInt (fromIntegral n) W32 - to_ipe_buf_ent :: CgInfoProvEnt -> [Word32] to_ipe_buf_ent cg_ipe = [ ipeTableName cg_ipe @@ -194,7 +191,7 @@ toCgIPE platform ctx module_name ipe = do coords = renderWithContext ctx (pprUserRealSpan False span) in (file, coords) label <- lookupStringTable $ ST.pack label_str - src_file <- lookupStringTable $ src_loc_file + src_file <- lookupStringTable src_loc_file src_span <- lookupStringTable $ ST.pack src_loc_span return $ CgInfoProvEnt { ipeInfoTablePtr = infoTablePtr ipe , ipeTableName = table_name ===================================== rts/include/rts/IPE.h ===================================== @@ -70,18 +70,18 @@ typedef struct IpeBufferListNode_ { // Everything below is read-only and generated by the codegen // This flag should be treated as a boolean - const StgWord compressed; + StgWord compressed; StgWord count; // When TNTC is enabled, these will point to the entry code // not the info table itself. - const StgInfoTable **tables; + StgInfoTable **tables; - const IpeBufferEntry *entries; + IpeBufferEntry *entries; StgWord entries_size; - const char *string_table; + char *string_table; StgWord string_table_size; } IpeBufferListNode; ===================================== testsuite/tests/rts/ipe/ipeEventLog_fromMap.c ===================================== @@ -19,7 +19,7 @@ int main(int argc, char *argv[]) { registerInfoProvList(list2); // Query an IPE to initialize the underlying hash map. - lookupIPE(list1->entries[0].info); + lookupIPE(list1->tables[0]); // Trace all IPE events. dumpIPEToEventLog(); ===================================== testsuite/tests/rts/ipe/ipeMap.c ===================================== @@ -45,10 +45,14 @@ HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) { init_string_table(&st); HaskellObj fortyTwo = UNTAG_CLOSURE(rts_mkInt(cap, 42)); - node->entries[0] = makeAnyProvEntry(cap, &st, fortyTwo, 42); - node->count = 1; node->next = NULL; + node->compressed = 0; + node->count = 1; + node->tables[0] = get_itbl(fortyTwo); + node->entries[0] = makeAnyProvEntry(cap, &st, 42); + node->entries_size = sizeof(IpeBufferEntry); node->string_table = st.buffer; + node->string_table_size = st.size; registerInfoProvList(node); @@ -77,10 +81,14 @@ void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap, init_string_table(&st); HaskellObj twentyThree = UNTAG_CLOSURE(rts_mkInt8(cap, 23)); - node->entries[0] = makeAnyProvEntry(cap, &st, twentyThree, 23); - node->count = 1; node->next = NULL; + node->compressed = 0; + node->count = 1; + node->tables[0] = get_itbl(twentyThree); + node->entries[0] = makeAnyProvEntry(cap, &st, 23); + node->entries_size = sizeof(IpeBufferEntry); node->string_table = st.buffer; + node->string_table_size = st.size; registerInfoProvList(node); @@ -109,11 +117,16 @@ void shouldFindTwoFromTheSameList(Capability *cap) { HaskellObj one = UNTAG_CLOSURE(rts_mkInt16(cap, 1)); HaskellObj two = UNTAG_CLOSURE(rts_mkInt32(cap, 2)); - node->entries[0] = makeAnyProvEntry(cap, &st, one, 1); - node->entries[1] = makeAnyProvEntry(cap, &st, two, 2); - node->count = 2; node->next = NULL; + node->compressed = 0; + node->count = 2; + node->tables[0] = get_itbl(one); + node->tables[1] = get_itbl(two); + node->entries[0] = makeAnyProvEntry(cap, &st, 1); + node->entries[1] = makeAnyProvEntry(cap, &st, 2); + node->entries_size = sizeof(IpeBufferEntry) * 2; node->string_table = st.buffer; + node->string_table_size = st.size; registerInfoProvList(node); ===================================== testsuite/tests/rts/ipe/ipe_lib.c ===================================== @@ -25,9 +25,8 @@ uint32_t add_string(StringTable *st, const char *s) { return n; } -IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj closure, int i) { +IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, int i) { IpeBufferEntry provEnt; - provEnt.info = get_itbl(closure); unsigned int tableNameLength = strlen("table_name_") + 3 /* digits */ + 1 /* null character */; char *tableName = malloc(sizeof(char) * tableNameLength); @@ -74,9 +73,11 @@ IpeBufferListNode *makeAnyProvEntries(Capability *cap, int start, int end) { init_string_table(&st); for (int i=start; i < end; i++) { HaskellObj closure = rts_mkInt(cap, 42); - node->entries[i] = makeAnyProvEntry(cap, &st, closure, i); + node->tables[i] = get_itbl(closure); + node->entries[i] = makeAnyProvEntry(cap, &st, i); } node->next = NULL; + node->compressed = 0; node->count = n; node->string_table = st.buffer; return node; ===================================== testsuite/tests/rts/ipe/ipe_lib.h ===================================== @@ -12,6 +12,6 @@ void init_string_table(StringTable *st); uint32_t add_string(StringTable *st, const char *s); IpeBufferListNode *makeAnyProvEntries(Capability *cap, int start, int end); -IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj closure, int i); +IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, int i); void dumpIPEToEventLog(void); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df06f7efc703e7349c7218cfda8c595ef60182e2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df06f7efc703e7349c7218cfda8c595ef60182e2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Feb 4 06:43:01 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 04 Feb 2023 01:43:01 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Windows: Remove mingwex dependency Message-ID: <63ddfe75b21de_1108fe526487663ae@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 8e5c7b33 by Ben Gamari at 2023-02-04T01:42:51-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 8d95d06c by Krzysztof Gogolewski at 2023-02-04T01:42:52-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Data/List/SetOps.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Env.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Stg/Lift/Monad.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Types/CostCentre.hs - configure.ac - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Packages.hs - libraries/base/GHC/Int.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aad5f12922489e80e990bdc7c858c1effbb916ac...8d95d06c6c23a2577416fdff4ad0e6bc07916437 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aad5f12922489e80e990bdc7c858c1effbb916ac...8d95d06c6c23a2577416fdff4ad0e6bc07916437 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Feb 4 09:13:19 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 04 Feb 2023 04:13:19 -0500 Subject: [Git][ghc/ghc][master] Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" Message-ID: <63de21af48500_1108fe2b215ec878026@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 4 changed files: - libraries/base/GHC/Int.hs - libraries/base/GHC/Word.hs - testsuite/tests/simplCore/should_run/T20203.stderr-ws-32 - testsuite/tests/simplCore/should_run/T20203.stderr-ws-64 Changes: ===================================== libraries/base/GHC/Int.hs ===================================== @@ -194,29 +194,29 @@ instance Bits Int8 where {-# INLINE testBit #-} {-# INLINE popCount #-} - (I8# x#) .&. (I8# y#) = I8# (word8ToInt8# (int8ToWord8# x# `andWord8#` int8ToWord8# y#)) - (I8# x#) .|. (I8# y#) = I8# (word8ToInt8# (int8ToWord8# x# `orWord8#` int8ToWord8# y#)) - (I8# x#) `xor` (I8# y#) = I8# (word8ToInt8# (int8ToWord8# x# `xorWord8#` int8ToWord8# y#)) - complement (I8# x#) = I8# (word8ToInt8# (notWord8# (int8ToWord8# x#))) + (I8# x#) .&. (I8# y#) = I8# (intToInt8# ((int8ToInt# x#) `andI#` (int8ToInt# y#))) + (I8# x#) .|. (I8# y#) = I8# (intToInt8# ((int8ToInt# x#) `orI#` (int8ToInt# y#))) + (I8# x#) `xor` (I8# y#) = I8# (intToInt8# ((int8ToInt# x#) `xorI#` (int8ToInt# y#))) + complement (I8# x#) = I8# (intToInt8# (notI# (int8ToInt# x#))) (I8# x#) `shift` (I# i#) - | isTrue# (i# >=# 0#) = I8# (x# `shiftLInt8#` i#) - | otherwise = I8# (x# `shiftRAInt8#` negateInt# i#) + | isTrue# (i# >=# 0#) = I8# (intToInt8# ((int8ToInt# x#) `iShiftL#` i#)) + | otherwise = I8# (intToInt8# ((int8ToInt# x#) `iShiftRA#` negateInt# i#)) (I8# x#) `shiftL` (I# i#) - | isTrue# (i# >=# 0#) = I8# (x# `shiftLInt8#` i#) + | isTrue# (i# >=# 0#) = I8# (intToInt8# ((int8ToInt# x#) `iShiftL#` i#)) | otherwise = overflowError - (I8# x#) `unsafeShiftL` (I# i#) = I8# (x# `uncheckedShiftLInt8#` i#) + (I8# x#) `unsafeShiftL` (I# i#) = I8# (intToInt8# ((int8ToInt# x#) `uncheckedIShiftL#` i#)) (I8# x#) `shiftR` (I# i#) - | isTrue# (i# >=# 0#) = I8# (x# `shiftRAInt8#` i#) + | isTrue# (i# >=# 0#) = I8# (intToInt8# ((int8ToInt# x#) `iShiftRA#` i#)) | otherwise = overflowError - (I8# x#) `unsafeShiftR` (I# i#) = I8# (x# `uncheckedShiftRAInt8#` i#) + (I8# x#) `unsafeShiftR` (I# i#) = I8# (intToInt8# ((int8ToInt# x#) `uncheckedIShiftRA#` i#)) (I8# x#) `rotate` (I# i#) | isTrue# (i'# ==# 0#) = I8# x# | otherwise - = I8# (word8ToInt8# ((x'# `uncheckedShiftLWord8#` i'#) `orWord8#` - (x'# `uncheckedShiftRLWord8#` (8# -# i'#)))) + = I8# (intToInt8# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#` + (x'# `uncheckedShiftRL#` (8# -# i'#))))) where - !x'# = int8ToWord8# x# + !x'# = narrow8Word# (int2Word# (int8ToInt# x#)) !i'# = word2Int# (int2Word# i# `and#` 7##) bitSizeMaybe i = Just (finiteBitSize i) bitSize i = finiteBitSize i @@ -405,29 +405,29 @@ instance Bits Int16 where {-# INLINE testBit #-} {-# INLINE popCount #-} - (I16# x#) .&. (I16# y#) = I16# (word16ToInt16# (int16ToWord16# x# `andWord16#` int16ToWord16# y#)) - (I16# x#) .|. (I16# y#) = I16# (word16ToInt16# (int16ToWord16# x# `orWord16#` int16ToWord16# y#)) - (I16# x#) `xor` (I16# y#) = I16# (word16ToInt16# (int16ToWord16# x# `xorWord16#` int16ToWord16# y#)) - complement (I16# x#) = I16# (word16ToInt16# (notWord16# (int16ToWord16# x#))) + (I16# x#) .&. (I16# y#) = I16# (intToInt16# ((int16ToInt# x#) `andI#` (int16ToInt# y#))) + (I16# x#) .|. (I16# y#) = I16# (intToInt16# ((int16ToInt# x#) `orI#` (int16ToInt# y#))) + (I16# x#) `xor` (I16# y#) = I16# (intToInt16# ((int16ToInt# x#) `xorI#` (int16ToInt# y#))) + complement (I16# x#) = I16# (intToInt16# (notI# (int16ToInt# x#))) (I16# x#) `shift` (I# i#) - | isTrue# (i# >=# 0#) = I16# (x# `shiftLInt16#` i#) - | otherwise = I16# (x# `shiftRAInt16#` negateInt# i#) + | isTrue# (i# >=# 0#) = I16# (intToInt16# ((int16ToInt# x#) `iShiftL#` i#)) + | otherwise = I16# (intToInt16# ((int16ToInt# x#) `iShiftRA#` negateInt# i#)) (I16# x#) `shiftL` (I# i#) - | isTrue# (i# >=# 0#) = I16# (x# `shiftLInt16#` i#) + | isTrue# (i# >=# 0#) = I16# (intToInt16# ((int16ToInt# x#) `iShiftL#` i#)) | otherwise = overflowError - (I16# x#) `unsafeShiftL` (I# i#) = I16# (x# `uncheckedShiftLInt16#` i#) + (I16# x#) `unsafeShiftL` (I# i#) = I16# (intToInt16# ((int16ToInt# x#) `uncheckedIShiftL#` i#)) (I16# x#) `shiftR` (I# i#) - | isTrue# (i# >=# 0#) = I16# (x# `shiftRAInt16#` i#) + | isTrue# (i# >=# 0#) = I16# (intToInt16# ((int16ToInt# x#) `iShiftRA#` i#)) | otherwise = overflowError - (I16# x#) `unsafeShiftR` (I# i#) = I16# (x# `uncheckedShiftRAInt16#` i#) + (I16# x#) `unsafeShiftR` (I# i#) = I16# (intToInt16# ((int16ToInt# x#) `uncheckedIShiftRA#` i#)) (I16# x#) `rotate` (I# i#) | isTrue# (i'# ==# 0#) = I16# x# | otherwise - = I16# (word16ToInt16# ((x'# `uncheckedShiftLWord16#` i'#) `orWord16#` - (x'# `uncheckedShiftRLWord16#` (16# -# i'#)))) + = I16# (intToInt16# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#` + (x'# `uncheckedShiftRL#` (16# -# i'#))))) where - !x'# = int16ToWord16# x# + !x'# = narrow16Word# (int2Word# (int16ToInt# x#)) !i'# = word2Int# (int2Word# i# `and#` 15##) bitSizeMaybe i = Just (finiteBitSize i) bitSize i = finiteBitSize i @@ -607,25 +607,25 @@ instance Bits Int32 where (I32# x#) `xor` (I32# y#) = I32# (intToInt32# ((int32ToInt# x#) `xorI#` (int32ToInt# y#))) complement (I32# x#) = I32# (intToInt32# (notI# (int32ToInt# x#))) (I32# x#) `shift` (I# i#) - | isTrue# (i# >=# 0#) = I32# (x# `shiftLInt32#` i#) - | otherwise = I32# (x# `shiftRAInt32#` negateInt# i#) + | isTrue# (i# >=# 0#) = I32# (intToInt32# ((int32ToInt# x#) `iShiftL#` i#)) + | otherwise = I32# (intToInt32# ((int32ToInt# x#) `iShiftRA#` negateInt# i#)) (I32# x#) `shiftL` (I# i#) - | isTrue# (i# >=# 0#) = I32# (x# `shiftLInt32#` i#) + | isTrue# (i# >=# 0#) = I32# (intToInt32# ((int32ToInt# x#) `iShiftL#` i#)) | otherwise = overflowError (I32# x#) `unsafeShiftL` (I# i#) = - I32# (x# `uncheckedShiftLInt32#` i#) + I32# (intToInt32# ((int32ToInt# x#) `uncheckedIShiftL#` i#)) (I32# x#) `shiftR` (I# i#) - | isTrue# (i# >=# 0#) = I32# (x# `shiftRAInt32#` i#) + | isTrue# (i# >=# 0#) = I32# (intToInt32# ((int32ToInt# x#) `iShiftRA#` i#)) | otherwise = overflowError - (I32# x#) `unsafeShiftR` (I# i#) = I32# (x# `uncheckedShiftRAInt32#` i#) + (I32# x#) `unsafeShiftR` (I# i#) = I32# (intToInt32# ((int32ToInt# x#) `uncheckedIShiftRA#` i#)) (I32# x#) `rotate` (I# i#) | isTrue# (i'# ==# 0#) = I32# x# | otherwise - = I32# (word32ToInt32# ((x'# `uncheckedShiftLWord32#` i'#) `orWord32#` - (x'# `uncheckedShiftRLWord32#` (32# -# i'#)))) + = I32# (intToInt32# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#` + (x'# `uncheckedShiftRL#` (32# -# i'#))))) where - !x'# = int32ToWord32# x# + !x'# = narrow32Word# (int2Word# (int32ToInt# x#)) !i'# = word2Int# (int2Word# i# `and#` 31##) bitSizeMaybe i = Just (finiteBitSize i) bitSize i = finiteBitSize i @@ -1095,31 +1095,10 @@ a `shiftRLInt32#` b = uncheckedShiftRLInt32# a b `andInt32#` intToInt32# (shift_ -shiftLInt8# :: Int8# -> Int# -> Int8# -a `shiftLInt8#` b = uncheckedShiftLInt8# a b `andInt8#` intToInt8# (shift_mask 8# b) - -shiftLInt16# :: Int16# -> Int# -> Int16# -a `shiftLInt16#` b = uncheckedShiftLInt16# a b `andInt16#` intToInt16# (shift_mask 16# b) - -shiftLInt32# :: Int32# -> Int# -> Int32# -a `shiftLInt32#` b = uncheckedShiftLInt32# a b `andInt32#` intToInt32# (shift_mask 32# b) - shiftLInt64# :: Int64# -> Int# -> Int64# a `shiftLInt64#` b = uncheckedIShiftL64# a b `andInt64#` intToInt64# (shift_mask 64# b) -shiftRAInt8# :: Int8# -> Int# -> Int8# -a `shiftRAInt8#` b | isTrue# (b >=# 8#) = intToInt8# (negateInt# (a `ltInt8#` (intToInt8# 0#))) - | otherwise = a `uncheckedShiftRAInt8#` b - -shiftRAInt16# :: Int16# -> Int# -> Int16# -a `shiftRAInt16#` b | isTrue# (b >=# 16#) = intToInt16# (negateInt# (a `ltInt16#` (intToInt16# 0#))) - | otherwise = a `uncheckedShiftRAInt16#` b - -shiftRAInt32# :: Int32# -> Int# -> Int32# -a `shiftRAInt32#` b | isTrue# (b >=# 32#) = intToInt32# (negateInt# (a `ltInt32#` (intToInt32# 0#))) - | otherwise = a `uncheckedShiftRAInt32#` b - shiftRAInt64# :: Int64# -> Int# -> Int64# a `shiftRAInt64#` b | isTrue# (b >=# 64#) = intToInt64# (negateInt# (a `ltInt64#` (intToInt64# 0#))) | otherwise = a `uncheckedIShiftRA64#` b ===================================== libraries/base/GHC/Word.hs ===================================== @@ -184,26 +184,26 @@ instance Bits Word8 where {-# INLINE testBit #-} {-# INLINE popCount #-} - (W8# x#) .&. (W8# y#) = W8# (x# `andWord8#` y#) - (W8# x#) .|. (W8# y#) = W8# (x# `orWord8#` y#) - (W8# x#) `xor` (W8# y#) = W8# (x# `xorWord8#` y#) - complement (W8# x#) = W8# (notWord8# x#) + (W8# x#) .&. (W8# y#) = W8# (wordToWord8# ((word8ToWord# x#) `and#` (word8ToWord# y#))) + (W8# x#) .|. (W8# y#) = W8# (wordToWord8# ((word8ToWord# x#) `or#` (word8ToWord# y#))) + (W8# x#) `xor` (W8# y#) = W8# (wordToWord8# ((word8ToWord# x#) `xor#` (word8ToWord# y#))) + complement (W8# x#) = W8# (wordToWord8# (not# (word8ToWord# x#))) (W8# x#) `shift` (I# i#) - | isTrue# (i# >=# 0#) = W8# (x# `shiftLWord8#` i#) - | otherwise = W8# (x# `shiftRLWord8#` negateInt# i#) + | isTrue# (i# >=# 0#) = W8# (wordToWord8# ((word8ToWord# x#) `shiftL#` i#)) + | otherwise = W8# (wordToWord8# ((word8ToWord# x#) `shiftRL#` negateInt# i#)) (W8# x#) `shiftL` (I# i#) - | isTrue# (i# >=# 0#) = W8# (x# `shiftLWord8#` i#) + | isTrue# (i# >=# 0#) = W8# (wordToWord8# ((word8ToWord# x#) `shiftL#` i#)) | otherwise = overflowError (W8# x#) `unsafeShiftL` (I# i#) = - W8# (x# `uncheckedShiftLWord8#` i#) + W8# (wordToWord8# ((word8ToWord# x#) `uncheckedShiftL#` i#)) (W8# x#) `shiftR` (I# i#) - | isTrue# (i# >=# 0#) = W8# (x# `shiftRLWord8#` i#) + | isTrue# (i# >=# 0#) = W8# (wordToWord8# ((word8ToWord# x#) `shiftRL#` i#)) | otherwise = overflowError - (W8# x#) `unsafeShiftR` (I# i#) = W8# (x# `uncheckedShiftRLWord8#` i#) + (W8# x#) `unsafeShiftR` (I# i#) = W8# (wordToWord8# ((word8ToWord# x#) `uncheckedShiftRL#` i#)) (W8# x#) `rotate` (I# i#) | isTrue# (i'# ==# 0#) = W8# x# - | otherwise = W8# ((x# `uncheckedShiftLWord8#` i'#) `orWord8#` - (x# `uncheckedShiftRLWord8#` (8# -# i'#))) + | otherwise = W8# (wordToWord8# (((word8ToWord# x#) `uncheckedShiftL#` i'#) `or#` + ((word8ToWord# x#) `uncheckedShiftRL#` (8# -# i'#)))) where !i'# = word2Int# (int2Word# i# `and#` 7##) bitSizeMaybe i = Just (finiteBitSize i) @@ -374,26 +374,26 @@ instance Bits Word16 where {-# INLINE testBit #-} {-# INLINE popCount #-} - (W16# x#) .&. (W16# y#) = W16# (x# `andWord16#` y#) - (W16# x#) .|. (W16# y#) = W16# (x# `orWord16#` y#) - (W16# x#) `xor` (W16# y#) = W16# (x# `xorWord16#` y#) - complement (W16# x#) = W16# (notWord16# x#) + (W16# x#) .&. (W16# y#) = W16# (wordToWord16# ((word16ToWord# x#) `and#` (word16ToWord# y#))) + (W16# x#) .|. (W16# y#) = W16# (wordToWord16# ((word16ToWord# x#) `or#` (word16ToWord# y#))) + (W16# x#) `xor` (W16# y#) = W16# (wordToWord16# ((word16ToWord# x#) `xor#` (word16ToWord# y#))) + complement (W16# x#) = W16# (wordToWord16# (not# (word16ToWord# x#))) (W16# x#) `shift` (I# i#) - | isTrue# (i# >=# 0#) = W16# (x# `shiftLWord16#` i#) - | otherwise = W16# (x# `shiftRLWord16#` negateInt# i#) + | isTrue# (i# >=# 0#) = W16# (wordToWord16# ((word16ToWord# x#) `shiftL#` i#)) + | otherwise = W16# (wordToWord16# ((word16ToWord# x#) `shiftRL#` negateInt# i#)) (W16# x#) `shiftL` (I# i#) - | isTrue# (i# >=# 0#) = W16# (x# `shiftLWord16#` i#) + | isTrue# (i# >=# 0#) = W16# (wordToWord16# ((word16ToWord# x#) `shiftL#` i#)) | otherwise = overflowError (W16# x#) `unsafeShiftL` (I# i#) = - W16# (x# `uncheckedShiftLWord16#` i#) + W16# (wordToWord16# ((word16ToWord# x#) `uncheckedShiftL#` i#)) (W16# x#) `shiftR` (I# i#) - | isTrue# (i# >=# 0#) = W16# (x# `shiftRLWord16#` i#) + | isTrue# (i# >=# 0#) = W16# (wordToWord16# ((word16ToWord# x#) `shiftRL#` i#)) | otherwise = overflowError - (W16# x#) `unsafeShiftR` (I# i#) = W16# (x# `uncheckedShiftRLWord16#` i#) + (W16# x#) `unsafeShiftR` (I# i#) = W16# (wordToWord16# ((word16ToWord# x#) `uncheckedShiftRL#` i#)) (W16# x#) `rotate` (I# i#) | isTrue# (i'# ==# 0#) = W16# x# - | otherwise = W16# ((x# `uncheckedShiftLWord16#` i'#) `orWord16#` - (x# `uncheckedShiftRLWord16#` (16# -# i'#))) + | otherwise = W16# (wordToWord16# (((word16ToWord# x#) `uncheckedShiftL#` i'#) `or#` + ((word16ToWord# x#) `uncheckedShiftRL#` (16# -# i'#)))) where !i'# = word2Int# (int2Word# i# `and#` 15##) bitSizeMaybe i = Just (finiteBitSize i) @@ -601,26 +601,26 @@ instance Bits Word32 where {-# INLINE testBit #-} {-# INLINE popCount #-} - (W32# x#) .&. (W32# y#) = W32# (x# `andWord32#` y#) - (W32# x#) .|. (W32# y#) = W32# (x# `orWord32#` y#) - (W32# x#) `xor` (W32# y#) = W32# (x# `xorWord32#` y#) - complement (W32# x#) = W32# (notWord32# x#) + (W32# x#) .&. (W32# y#) = W32# (wordToWord32# ((word32ToWord# x#) `and#` (word32ToWord# y#))) + (W32# x#) .|. (W32# y#) = W32# (wordToWord32# ((word32ToWord# x#) `or#` (word32ToWord# y#))) + (W32# x#) `xor` (W32# y#) = W32# (wordToWord32# ((word32ToWord# x#) `xor#` (word32ToWord# y#))) + complement (W32# x#) = W32# (wordToWord32# (not# (word32ToWord# x#))) (W32# x#) `shift` (I# i#) - | isTrue# (i# >=# 0#) = W32# (x# `shiftLWord32#` i#) - | otherwise = W32# (x# `shiftRLWord32#` negateInt# i#) + | isTrue# (i# >=# 0#) = W32# (wordToWord32# ((word32ToWord# x#) `shiftL#` i#)) + | otherwise = W32# (wordToWord32# ((word32ToWord# x#) `shiftRL#` negateInt# i#)) (W32# x#) `shiftL` (I# i#) - | isTrue# (i# >=# 0#) = W32# (x# `shiftLWord32#` i#) + | isTrue# (i# >=# 0#) = W32# (wordToWord32# ((word32ToWord# x#) `shiftL#` i#)) | otherwise = overflowError (W32# x#) `unsafeShiftL` (I# i#) = - W32# (x# `uncheckedShiftLWord32#` i#) + W32# (wordToWord32# ((word32ToWord# x#) `uncheckedShiftL#` i#)) (W32# x#) `shiftR` (I# i#) - | isTrue# (i# >=# 0#) = W32# (x# `shiftRLWord32#` i#) + | isTrue# (i# >=# 0#) = W32# (wordToWord32# ((word32ToWord# x#) `shiftRL#` i#)) | otherwise = overflowError - (W32# x#) `unsafeShiftR` (I# i#) = W32# (x# `uncheckedShiftRLWord32#` i#) + (W32# x#) `unsafeShiftR` (I# i#) = W32# (wordToWord32# ((word32ToWord# x#) `uncheckedShiftRL#` i#)) (W32# x#) `rotate` (I# i#) | isTrue# (i'# ==# 0#) = W32# x# - | otherwise = W32# ((x# `uncheckedShiftLWord32#` i'#) `orWord32#` - (x# `uncheckedShiftRLWord32#` (32# -# i'#))) + | otherwise = W32# (wordToWord32# (((word32ToWord# x#) `uncheckedShiftL#` i'#) `or#` + ((word32ToWord# x#) `uncheckedShiftRL#` (32# -# i'#)))) where !i'# = word2Int# (int2Word# i# `and#` 31##) bitSizeMaybe i = Just (finiteBitSize i) @@ -894,34 +894,10 @@ bitReverse64 (W64# w#) = W64# (bitReverse64# w#) -- The following safe shift operations wrap unchecked primops to take this into -- account: 0 is consistently returned when the shift amount is too big. -shiftRLWord8# :: Word8# -> Int# -> Word8# -a `shiftRLWord8#` b = uncheckedShiftRLWord8# a b - `andWord8#` wordToWord8# (int2Word# (shift_mask 8# b)) - -shiftRLWord16# :: Word16# -> Int# -> Word16# -a `shiftRLWord16#` b = uncheckedShiftRLWord16# a b - `andWord16#` wordToWord16# (int2Word# (shift_mask 16# b)) - -shiftRLWord32# :: Word32# -> Int# -> Word32# -a `shiftRLWord32#` b = uncheckedShiftRLWord32# a b - `andWord32#` wordToWord32# (int2Word# (shift_mask 32# b)) - shiftRLWord64# :: Word64# -> Int# -> Word64# a `shiftRLWord64#` b = uncheckedShiftRL64# a b `and64#` int64ToWord64# (intToInt64# (shift_mask 64# b)) -shiftLWord8# :: Word8# -> Int# -> Word8# -a `shiftLWord8#` b = uncheckedShiftLWord8# a b - `andWord8#` wordToWord8# (int2Word# (shift_mask 8# b)) - -shiftLWord16# :: Word16# -> Int# -> Word16# -a `shiftLWord16#` b = uncheckedShiftLWord16# a b - `andWord16#` wordToWord16# (int2Word# (shift_mask 16# b)) - -shiftLWord32# :: Word32# -> Int# -> Word32# -a `shiftLWord32#` b = uncheckedShiftLWord32# a b - `andWord32#` wordToWord32# (int2Word# (shift_mask 32# b)) - shiftLWord64# :: Word64# -> Int# -> Word64# a `shiftLWord64#` b = uncheckedShiftL64# a b `and64#` int64ToWord64# (intToInt64# (shift_mask 64# b)) ===================================== testsuite/tests/simplCore/should_run/T20203.stderr-ws-32 ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 290, types: 141, coercions: 0, joins: 0/0} + = {terms: 340, types: 140, coercions: 0, joins: 0/0} bitOrTwoVarInt = \ x y -> @@ -24,33 +24,50 @@ bitOrTwoVarInt8 case x of { I8# x# -> case y of { I8# x#1 -> I8# - (word8ToInt8# - (orWord8# 17#Word8 (orWord8# (int8ToWord8# x#) (int8ToWord8# x#1)))) + (intToInt8# + (orI# + (int8ToInt# (intToInt8# (orI# (int8ToInt# x#) 1#))) + (int8ToInt# (intToInt8# (orI# (int8ToInt# x#1) 16#))))) } } -bitAndInt1 = I8# 0#Int8 - bitAndTwoVarInt8 = \ x y -> - case x of { I8# x# -> case y of { I8# x#1 -> bitAndInt1 } } + case x of { I8# x# -> + case y of { I8# x#1 -> + I8# + (intToInt8# + (andI# + (int8ToInt# (intToInt8# (andI# (int8ToInt# x#) 1#))) + (int8ToInt# (intToInt8# (andI# (int8ToInt# x#1) 16#))))) + } + } bitOrInt8 = \ x -> case x of { I8# x# -> - I8# (word8ToInt8# (orWord8# 17#Word8 (int8ToWord8# x#))) + I8# + (intToInt8# + (orI# (int8ToInt# (intToInt8# (orI# (int8ToInt# x#) 1#))) 16#)) } -bitAndInt8 = \ x -> case x of { I8# x# -> bitAndInt1 } +bitAndInt8 + = / x -> + case x of { I8# x# -> + I8# + (intToInt8# + (andI# (int8ToInt# (intToInt8# (andI# (int8ToInt# x#) 1#))) 16#)) + } bitOrTwoVarInt16 = \ x y -> case x of { I16# x# -> case y of { I16# x#1 -> I16# - (word16ToInt16# - (orWord16# - 255#Word16 (orWord16# (int16ToWord16# x#) (int16ToWord16# x#1)))) + (intToInt16# + (orI# + (int16ToInt# (intToInt16# (orI# (int16ToInt# x#) 250#))) + (int16ToInt# (intToInt16# (orI# (int16ToInt# x#1) 175#))))) } } @@ -59,22 +76,28 @@ bitAndTwoVarInt16 case x of { I16# x# -> case y of { I16# x#1 -> I16# - (word16ToInt16# - (andWord16# - 170#Word16 (andWord16# (int16ToWord16# x#) (int16ToWord16# x#1)))) - } + (intToInt16# + (andI# + (int16ToInt# (intToInt16# (andI# (int16ToInt# x#) 250#))) + (int16ToInt# (intToInt16# (andI# (int16ToInt# x#1) 175#))))) } } bitOrInt16 = \ x -> case x of { I16# x# -> - I16# (word16ToInt16# (orWord16# 255#Word16 (int16ToWord16# x#))) + I16# + (intToInt16# + (orI# + (int16ToInt# (intToInt16# (orI# (int16ToInt# x#) 250#))) 175#)) } bitAndInt16 = \ x -> case x of { I16# x# -> - I16# (word16ToInt16# (andWord16# 170#Word16 (int16ToWord16# x#))) + I16# + (intToInt16# + (andI# + (int16ToInt# (intToInt16# (andI# (int16ToInt# x#) 250#))) 175#)) } bitOrTwoVarInt32 @@ -125,7 +148,7 @@ bitOrTwoVarInt64 case y of { I64# x#1 -> I64# (word64ToInt64# - (or64# 255#Word64 (or64# (int64ToWord64# x#) (int64ToWord64# x#1)))) + (or64# 255#Word64 (or64# (int64ToWord64# x#) (int64ToWord64# x#1)))) } } @@ -135,7 +158,7 @@ bitAndTwoVarInt64 case y of { I64# x#1 -> I64# (word64ToInt64# - (and64# 170#Word64 (and64# (int64ToWord64# x#) (int64ToWord64# x#1)))) + (and64# 170#Word64 (and64# (int64ToWord64# x#) (int64ToWord64# x#1)))) } } @@ -144,7 +167,7 @@ bitOrInt64 case x of { I64# x# -> I64# (word64ToInt64# (or64# 255#Word64 (int64ToWord64# x#))) } - + bitAndInt64 = / x -> case x of { I64# x# -> ===================================== testsuite/tests/simplCore/should_run/T20203.stderr-ws-64 ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 290, types: 141, coercions: 0, joins: 0/0} + = {terms: 340, types: 140, coercions: 0, joins: 0/0} bitOrTwoVarInt = \ x y -> @@ -24,34 +24,50 @@ bitOrTwoVarInt8 case x of { I8# x# -> case y of { I8# x#1 -> I8# - (word8ToInt8# - (orWord8# - 17#Word8 (orWord8# (int8ToWord8# x#) (int8ToWord8# x#1)))) + (intToInt8# + (orI# + (int8ToInt# (intToInt8# (orI# (int8ToInt# x#) 1#))) + (int8ToInt# (intToInt8# (orI# (int8ToInt# x#1) 16#))))) } } -bitAndInt1 = I8# 0#Int8 - bitAndTwoVarInt8 = \ x y -> - case x of { I8# x# -> case y of { I8# x#1 -> bitAndInt1 } } + case x of { I8# x# -> + case y of { I8# x#1 -> + I8# + (intToInt8# + (andI# + (int8ToInt# (intToInt8# (andI# (int8ToInt# x#) 1#))) + (int8ToInt# (intToInt8# (andI# (int8ToInt# x#1) 16#))))) + } + } bitOrInt8 = \ x -> case x of { I8# x# -> - I8# (word8ToInt8# (orWord8# 17#Word8 (int8ToWord8# x#))) + I8# + (intToInt8# + (orI# (int8ToInt# (intToInt8# (orI# (int8ToInt# x#) 1#))) 16#)) } -bitAndInt8 = \ x -> case x of { I8# x# -> bitAndInt1 } +bitAndInt8 + = \ x -> + case x of { I8# x# -> + I8# + (intToInt8# + (andI# (int8ToInt# (intToInt8# (andI# (int8ToInt# x#) 1#))) 16#)) + } bitOrTwoVarInt16 = \ x y -> case x of { I16# x# -> case y of { I16# x#1 -> I16# - (word16ToInt16# - (orWord16# - 255#Word16 (orWord16# (int16ToWord16# x#) (int16ToWord16# x#1)))) + (intToInt16# + (orI# + (int16ToInt# (intToInt16# (orI# (int16ToInt# x#) 250#))) + (int16ToInt# (intToInt16# (orI# (int16ToInt# x#1) 175#))))) } } @@ -60,22 +76,29 @@ bitAndTwoVarInt16 case x of { I16# x# -> case y of { I16# x#1 -> I16# - (word16ToInt16# - (andWord16# - 170#Word16 (andWord16# (int16ToWord16# x#) (int16ToWord16# x#1)))) + (intToInt16# + (andI# + (int16ToInt# (intToInt16# (andI# (int16ToInt# x#) 250#))) + (int16ToInt# (intToInt16# (andI# (int16ToInt# x#1) 175#))))) } } bitOrInt16 = \ x -> case x of { I16# x# -> - I16# (word16ToInt16# (orWord16# 255#Word16 (int16ToWord16# x#))) + I16# + (intToInt16# + (orI# + (int16ToInt# (intToInt16# (orI# (int16ToInt# x#) 250#))) 175#)) } bitAndInt16 = \ x -> case x of { I16# x# -> - I16# (word16ToInt16# (andWord16# 170#Word16 (int16ToWord16# x#))) + I16# + (intToInt16# + (andI# + (int16ToInt# (intToInt16# (andI# (int16ToInt# x#) 250#))) 175#)) } bitOrTwoVarInt32 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/25537dfda4ae59bc0321b229ca9ff924ef64d1fa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/25537dfda4ae59bc0321b229ca9ff924ef64d1fa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Feb 4 09:13:57 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 04 Feb 2023 04:13:57 -0500 Subject: [Git][ghc/ghc][master] Minor refactor Message-ID: <63de21d543033_1108fe12881c087837bf@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 17 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Data/List/SetOps.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/Iface/Env.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Stg/Lift/Monad.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -96,7 +96,6 @@ import Data.Foldable ( for_, toList ) import Data.List.NonEmpty ( NonEmpty(..), groupWith ) import Data.List ( partition ) import Data.Maybe -import Data.Ord ( comparing ) import GHC.Data.Pair import GHC.Base (oneShot) import GHC.Data.Unboxed @@ -478,7 +477,7 @@ lintCoreBindings' cfg binds -- M.n{r3} = ... -- M.n{r29} = ... -- because they both get the same linker symbol - ext_dups = snd $ removeDups (comparing ord_ext) $ + ext_dups = snd $ removeDupsOn ord_ext $ filter isExternalName $ map Var.varName binders ord_ext n = (nameModule n, nameOccName n) ===================================== compiler/GHC/Core/Make.hs ===================================== @@ -648,12 +648,12 @@ mkSmallTupleSelector1 vars the_var scrut_var scrut -- To avoid shadowing, we use uniques to invent new variables. -- -- If necessary we pattern match on a "big" tuple. -mkBigTupleCase :: UniqSupply -- ^ For inventing names of intermediate variables - -> [Id] -- ^ The tuple identifiers to pattern match on; +mkBigTupleCase :: MonadUnique m -- For inventing names of intermediate variables + => [Id] -- ^ The tuple identifiers to pattern match on; -- Bring these into scope in the body -> CoreExpr -- ^ Body of the case -> CoreExpr -- ^ Scrutinee - -> CoreExpr + -> m CoreExpr -- ToDo: eliminate cases where none of the variables are needed. -- -- mkBigTupleCase uniqs [a,b,c,d] body v e @@ -661,11 +661,11 @@ mkBigTupleCase :: UniqSupply -- ^ For inventing names of intermediate vari -- case p of p { (a,b) -> -- case q of q { (c,d) -> -- body }}} -mkBigTupleCase us vars body scrut - = mk_tuple_case wrapped_us (chunkify wrapped_vars) wrapped_body +mkBigTupleCase vars body scrut + = do us <- getUniqueSupplyM + let (wrapped_us, wrapped_vars, wrapped_body) = foldr unwrap (us,[],body) vars + return $ mk_tuple_case wrapped_us (chunkify wrapped_vars) wrapped_body where - (wrapped_us, wrapped_vars, wrapped_body) = foldr unwrap (us,[],body) vars - scrut_ty = exprType scrut unwrap var (us,vars,body) ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -2090,9 +2090,8 @@ dataConInstPat fss uniqs mult con inst_tys arg_ids = zipWith4 mk_id_var id_uniqs id_fss arg_tys arg_strs mk_id_var uniq fs (Scaled m ty) str = setCaseBndrEvald str $ -- See Note [Mark evaluated arguments] - mkLocalIdOrCoVar name (mult `mkMultMul` m) (Type.substTy full_subst ty) - where - name = mkInternalName uniq (mkVarOccFS fs) noSrcSpan + mkUserLocalOrCoVar (mkVarOccFS fs) uniq + (mult `mkMultMul` m) (Type.substTy full_subst ty) noSrcSpan {- Note [Mark evaluated arguments] ===================================== compiler/GHC/Data/List/SetOps.hs ===================================== @@ -18,7 +18,7 @@ module GHC.Data.List.SetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, nubOrdBy, findDupsEq, + hasNoDups, removeDups, removeDupsOn, nubOrdBy, findDupsEq, equivClasses, -- Indexing @@ -37,6 +37,7 @@ import GHC.Utils.Misc import qualified Data.List as L import qualified Data.List.NonEmpty as NE import Data.List.NonEmpty (NonEmpty(..)) +import Data.Ord (comparing) import qualified Data.Set as S getNth :: Outputable a => [a] -> Int -> a @@ -193,6 +194,9 @@ removeDups cmp xs collect_dups dups_so_far (x :| []) = (dups_so_far, x) collect_dups dups_so_far dups@(x :| _) = (dups:dups_so_far, x) +removeDupsOn :: Ord b => (a -> b) -> [a] -> ([a], [NonEmpty a]) +removeDupsOn f x = removeDups (comparing f) x + -- | Remove the duplicates from a list using the provided -- comparison function. nubOrdBy :: (a -> a -> Ordering) -> [a] -> [a] ===================================== compiler/GHC/HsToCore/Arrows.hs ===================================== @@ -158,9 +158,9 @@ because the list of variables is typically not yet defined. -- = case v of v { (x1, .., xn) -> body } -- But the matching may be nested if the tuple is very big -coreCaseTuple :: UniqSupply -> Id -> [Id] -> CoreExpr -> CoreExpr -coreCaseTuple uniqs scrut_var vars body - = mkBigTupleCase uniqs vars body (Var scrut_var) +coreCaseTuple :: Id -> [Id] -> CoreExpr -> DsM CoreExpr +coreCaseTuple scrut_var vars body + = mkBigTupleCase vars body (Var scrut_var) coreCasePair :: Id -> Id -> Id -> CoreExpr -> CoreExpr coreCasePair scrut_var var1 var2 body @@ -231,9 +231,8 @@ matchEnvStack :: [Id] -- x1..xn -> CoreExpr -- e -> DsM CoreExpr matchEnvStack env_ids stack_id body = do - uniqs <- newUniqueSupply tup_var <- newSysLocalDs ManyTy (mkBigCoreVarTupTy env_ids) - let match_env = coreCaseTuple uniqs tup_var env_ids body + match_env <- coreCaseTuple tup_var env_ids body pair_id <- newSysLocalDs ManyTy (mkCorePairTy (idType tup_var) (idType stack_id)) return (Lam pair_id (coreCasePair pair_id tup_var stack_id match_env)) @@ -250,9 +249,9 @@ matchEnv :: [Id] -- x1..xn -> CoreExpr -- e -> DsM CoreExpr matchEnv env_ids body = do - uniqs <- newUniqueSupply tup_id <- newSysLocalDs ManyTy (mkBigCoreVarTupTy env_ids) - return (Lam tup_id (coreCaseTuple uniqs tup_id env_ids body)) + tup_case <- coreCaseTuple tup_id env_ids body + return (Lam tup_id tup_case) ---------------------------------------------- -- matchVarStack @@ -957,11 +956,10 @@ dsCmdStmt ids local_vars out_ids (BindStmt _ pat cmd) env_ids = do -- \ (p, (xs2)) -> (zs) env_id <- newSysLocalDs ManyTy env_ty2 - uniqs <- newUniqueSupply let after_c_ty = mkCorePairTy pat_ty env_ty2 out_ty = mkBigCoreVarTupTy out_ids - body_expr = coreCaseTuple uniqs env_id env_ids2 (mkBigCoreVarTup out_ids) + body_expr <- coreCaseTuple env_id env_ids2 (mkBigCoreVarTup out_ids) fail_expr <- mkFailExpr (StmtCtxt (HsDoStmt (DoExpr Nothing))) out_ty pat_id <- selectSimpleMatchVarL ManyTy pat @@ -1029,12 +1027,11 @@ dsCmdStmt ids local_vars out_ids -- post_loop_fn = \((later_ids),(env2_ids)) -> (out_ids) - uniqs <- newUniqueSupply env2_id <- newSysLocalDs ManyTy env2_ty let later_ty = mkBigCoreVarTupTy later_ids post_pair_ty = mkCorePairTy later_ty env2_ty - post_loop_body = coreCaseTuple uniqs env2_id env2_ids (mkBigCoreVarTup out_ids) + post_loop_body <- coreCaseTuple env2_id env2_ids (mkBigCoreVarTup out_ids) post_loop_fn <- matchEnvStack later_ids env2_id post_loop_body ===================================== compiler/GHC/HsToCore/ListComp.hs ===================================== @@ -444,15 +444,13 @@ mkUnzipBind _ elt_tys ; unzip_fn <- newSysLocalDs ManyTy unzip_fn_ty - ; [us1, us2] <- sequence [newUniqueSupply, newUniqueSupply] - ; let nil_tuple = mkBigCoreTup (map mkNilExpr elt_tys) concat_expressions = map mkConcatExpression (zip3 elt_tys (map Var xs) (map Var xss)) tupled_concat_expression = mkBigCoreTup concat_expressions - folder_body_inner_case = mkBigTupleCase us1 xss tupled_concat_expression (Var axs) - folder_body_outer_case = mkBigTupleCase us2 xs folder_body_inner_case (Var ax) - folder_body = mkLams [ax, axs] folder_body_outer_case + ; folder_body_inner_case <- mkBigTupleCase xss tupled_concat_expression (Var axs) + ; folder_body_outer_case <- mkBigTupleCase xs folder_body_inner_case (Var ax) + ; let folder_body = mkLams [ax, axs] folder_body_outer_case ; unzip_body <- mkFoldrExpr elt_tuple_ty elt_list_tuple_ty folder_body nil_tuple (Var ys) ; return (Just (unzip_fn, mkLams [ys] unzip_body)) } @@ -546,9 +544,8 @@ dsMcStmt (TransStmt { trS_stmts = stmts, trS_bndrs = bndrs ; body <- dsMcStmts stmts_rest ; n_tup_var' <- newSysLocalDs ManyTy n_tup_ty' ; tup_n_expr' <- mkMcUnzipM form fmap_op n_tup_var' from_bndr_tys - ; us <- newUniqueSupply ; let rhs' = mkApps usingExpr' usingArgs' - body' = mkBigTupleCase us to_bndrs body tup_n_expr' + ; body' <- mkBigTupleCase to_bndrs body tup_n_expr' ; dsSyntaxExpr bind_op [rhs', Lam n_tup_var' body'] } @@ -592,9 +589,9 @@ matchTuple :: [Id] -> CoreExpr -> DsM CoreExpr -- returns the Core term -- \x. case x of (a,b,c) -> body matchTuple ids body - = do { us <- newUniqueSupply - ; tup_id <- newSysLocalDs ManyTy (mkBigCoreVarTupTy ids) - ; return (Lam tup_id $ mkBigTupleCase us ids body (Var tup_id)) } + = do { tup_id <- newSysLocalDs ManyTy (mkBigCoreVarTupTy ids) + ; tup_case <- mkBigTupleCase ids body (Var tup_id) + ; return (Lam tup_id tup_case) } -- general `rhs' >>= \pat -> stmts` desugaring where `rhs'` is already a -- desugared `CoreExpr` ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -640,8 +640,7 @@ nameTyCt :: PredType -> DsM EvVar nameTyCt pred_ty = do unique <- getUniqueM let occname = mkVarOccFS (fsLit ("pm_"++show unique)) - idname = mkInternalName unique occname noSrcSpan - return (mkLocalIdOrCoVar idname ManyTy pred_ty) + return (mkUserLocalOrCoVar occname unique ManyTy pred_ty noSrcSpan) ----------------------------- -- ** Adding term constraints ===================================== compiler/GHC/HsToCore/Pmc/Utils.hs ===================================== @@ -51,8 +51,7 @@ traceWhenFailPm herald doc act = MaybeT $ do mkPmId :: Type -> DsM Id mkPmId ty = getUniqueM >>= \unique -> let occname = mkVarOccFS $ fsLit "pm" - name = mkInternalName unique occname noSrcSpan - in return (mkLocalIdOrCoVar name ManyTy ty) + in return (mkUserLocalOrCoVar occname unique ManyTy ty noSrcSpan) {-# NOINLINE mkPmId #-} -- We'll CPR deeply, that should be enough -- | All warning flags that need to run the pattern match checker. ===================================== compiler/GHC/Iface/Env.hs ===================================== @@ -262,9 +262,9 @@ newIfaceName occ newIfaceNames :: [OccName] -> IfL [Name] newIfaceNames occs - = do { uniqs <- newUniqueSupply + = do { uniqs <- getUniquesM ; return [ mkInternalName uniq occ noSrcSpan - | (occ,uniq) <- occs `zip` uniqsFromSupply uniqs] } + | (occ,uniq) <- occs `zip` uniqs] } trace_if :: Logger -> SDoc -> IO () {-# INLINE trace_if #-} ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -1674,8 +1674,7 @@ tcIfaceAlt scrut mult (tycon, inst_tys) (IfaceAlt (IfaceDataAlt data_occ) arg_st tcIfaceDataAlt :: Mult -> DataCon -> [Type] -> [FastString] -> IfaceExpr -> IfL CoreAlt tcIfaceDataAlt mult con inst_tys arg_strs rhs - = do { us <- newUniqueSupply - ; let uniqs = uniqsFromSupply us + = do { uniqs <- getUniquesM ; let (ex_tvs, arg_ids) = dataConRepFSInstPat arg_strs uniqs mult con inst_tys ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -64,7 +64,7 @@ import GHC.Types.Name.Reader import GHC.Types.Unique.Set import GHC.Types.SourceText import GHC.Utils.Misc -import GHC.Data.List.SetOps ( removeDups ) +import GHC.Data.List.SetOps ( removeDupsOn ) import GHC.Utils.Error import GHC.Utils.Panic import GHC.Utils.Panic.Plain @@ -1305,7 +1305,7 @@ rnParallelStmts ctxt return_op segs thing_inside -> [Name] -> [ParStmtBlock GhcPs GhcPs] -> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars) rn_segs _ bndrs_so_far [] - = do { let (bndrs', dups) = removeDups cmpByOcc bndrs_so_far + = do { let (bndrs', dups) = removeDupsOn nameOccName bndrs_so_far ; mapM_ dupErr dups ; (thing, fvs) <- bindLocalNames bndrs' (thing_inside bndrs') ; return (([], thing), fvs) } @@ -1321,7 +1321,6 @@ rnParallelStmts ctxt return_op segs thing_inside ; let seg' = ParStmtBlock x stmts' used_bndrs return_op ; return ((seg':segs', thing), fvs) } - cmpByOcc n1 n2 = nameOccName n1 `compare` nameOccName n2 dupErr vs = addErr $ TcRnListComprehensionDuplicateBinding (NE.head vs) lookupQualifiedDoStmtName :: HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars) ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -62,7 +62,7 @@ import GHC.Driver.Session import GHC.Utils.Misc ( lengthExceeds, partitionWith ) import GHC.Utils.Panic import GHC.Driver.Env ( HscEnv(..), hsc_home_unit) -import GHC.Data.List.SetOps ( findDupsEq, removeDups, equivClasses ) +import GHC.Data.List.SetOps ( findDupsEq, removeDupsOn, equivClasses ) import GHC.Data.Graph.Directed ( SCC, flattenSCC, flattenSCCs, Node(..) , stronglyConnCompFromEdgedVerticesUniq ) import GHC.Types.Unique.Set @@ -1604,7 +1604,7 @@ rnStandaloneKindSignatures -> [LStandaloneKindSig GhcPs] -> RnM [(LStandaloneKindSig GhcRn, FreeVars)] rnStandaloneKindSignatures tc_names kisigs - = do { let (no_dups, dup_kisigs) = removeDups (compare `on` get_name) kisigs + = do { let (no_dups, dup_kisigs) = removeDupsOn get_name kisigs get_name = standaloneKindSigName . unLoc ; mapM_ dupKindSig_Err dup_kisigs ; mapM (wrapLocFstMA (rnStandaloneKindSignature tc_names)) no_dups @@ -1682,7 +1682,7 @@ rnRoleAnnots :: NameSet rnRoleAnnots tc_names role_annots = do { -- Check for duplicates *before* renaming, to avoid -- lumping together all the unboundNames - let (no_dups, dup_annots) = removeDups (compare `on` get_name) role_annots + let (no_dups, dup_annots) = removeDupsOn get_name role_annots get_name = roleAnnotDeclName . unLoc ; mapM_ dupRoleAnnotErr dup_annots ; mapM (wrapLocMA rn_role_annot1) no_dups } ===================================== compiler/GHC/Rename/Utils.hs ===================================== @@ -57,7 +57,7 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Misc import GHC.Types.Basic ( TopLevelFlag(..), Origin(Generated) ) -import GHC.Data.List.SetOps ( removeDups ) +import GHC.Data.List.SetOps ( removeDupsOn ) import GHC.Data.Maybe ( whenIsJust ) import GHC.Driver.Session import GHC.Data.FastString @@ -114,14 +114,14 @@ checkDupRdrNames :: [LocatedN RdrName] -> RnM () checkDupRdrNames rdr_names_w_loc = mapM_ (dupNamesErr getLocA) dups where - (_, dups) = removeDups (\n1 n2 -> unLoc n1 `compare` unLoc n2) rdr_names_w_loc + (_, dups) = removeDupsOn unLoc rdr_names_w_loc checkDupRdrNamesN :: [LocatedN RdrName] -> RnM () -- Check for duplicated names in a binding group checkDupRdrNamesN rdr_names_w_loc = mapM_ (dupNamesErr getLocA) dups where - (_, dups) = removeDups (\n1 n2 -> unLoc n1 `compare` unLoc n2) rdr_names_w_loc + (_, dups) = removeDupsOn unLoc rdr_names_w_loc checkDupNames :: [Name] -> RnM () -- Check for duplicated names in a binding group @@ -132,7 +132,7 @@ check_dup_names :: [Name] -> RnM () check_dup_names names = mapM_ (dupNamesErr nameSrcSpan) dups where - (_, dups) = removeDups (\n1 n2 -> nameOccName n1 `compare` nameOccName n2) names + (_, dups) = removeDupsOn nameOccName names --------------------- checkShadowedRdrNames :: [LocatedN RdrName] -> RnM () ===================================== compiler/GHC/Stg/Lift/Monad.hs ===================================== @@ -275,15 +275,13 @@ withSubstBndrs = runContT . traverse (ContT . withSubstBndr) -- binder and fresh name generation. withLiftedBndr :: DIdSet -> Id -> (Id -> LiftM a) -> LiftM a withLiftedBndr abs_ids bndr inner = do - uniq <- getUniqueM let str = fsLit "$l" `appendFS` occNameFS (getOccName bndr) let ty = mkLamTypes (dVarSetElems abs_ids) (idType bndr) - let bndr' + bndr' <- -- See Note [transferPolyIdInfo] in GHC.Types.Id. We need to do this at least -- for arity information. - = transferPolyIdInfo bndr (dVarSetElems abs_ids) - . mkSysLocal str uniq ManyTy - $ ty + transferPolyIdInfo bndr (dVarSetElems abs_ids) + <$> mkSysLocalM str ManyTy ty LiftM $ RWS.local (\e -> e { e_subst = extendSubst bndr bndr' $ extendInScope bndr' $ e_subst e ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -3692,14 +3692,13 @@ splitTyConKind :: SkolemInfo -- See also Note [Datatype return kinds] in GHC.Tc.TyCl splitTyConKind skol_info in_scope avoid_occs kind = do { loc <- getSrcSpanM - ; uniqs <- newUniqueSupply + ; new_uniqs <- getUniquesM ; rdr_env <- getLocalRdrEnv ; lvl <- getTcLevel ; let new_occs = Inf.filter (\ occ -> isNothing (lookupLocalRdrOcc rdr_env occ) && -- Note [Avoid name clashes for associated data types] not (occ `elem` avoid_occs)) $ mkOccName tvName <$> allNameStrings - new_uniqs = uniqsFromSupply uniqs subst = mkEmptySubst in_scope details = SkolemTv skol_info (pushTcLevel lvl) False -- As always, allocate skolems one level in ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -729,9 +729,9 @@ newSysLocalId fs w ty newSysLocalIds :: FastString -> [Scaled TcType] -> TcRnIf gbl lcl [TcId] newSysLocalIds fs tys - = do { us <- newUniqueSupply + = do { us <- getUniquesM ; let mkId' n (Scaled w t) = mkSysLocal fs n w t - ; return (zipWith mkId' (uniqsFromSupply us) tys) } + ; return (zipWith mkId' us tys) } instance MonadUnique (IOEnv (Env gbl lcl)) where getUniqueM = newUnique ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -770,13 +770,11 @@ newMetaTyVarName :: FastString -> TcM Name -- the unifier; see GHC.Tc.Utils.Unify.nicer_to_update_tv1, and -- GHC.Tc.Solver.Canonical.canEqTyVarTyVar (nicer_to_update_tv2) newMetaTyVarName str - = do { uniq <- newUnique - ; return (mkSystemName uniq (mkTyVarOccFS str)) } + = newSysName (mkTyVarOccFS str) cloneMetaTyVarName :: Name -> TcM Name cloneMetaTyVarName name - = do { uniq <- newUnique - ; return (mkSystemName uniq (nameOccName name)) } + = newSysName (nameOccName name) -- See Note [Name of an instantiated type variable] {- Note [Name of an instantiated type variable] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7612dc713d5a1f108cfd6eb731435b090fbb8809 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7612dc713d5a1f108cfd6eb731435b090fbb8809 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Feb 4 10:50:56 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sat, 04 Feb 2023 05:50:56 -0500 Subject: [Git][ghc/ghc][wip/int-index/visibility-subsumption] WIP: Visibility subsumption Message-ID: <63de38908389f_1108fe5265c7869eb@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/visibility-subsumption at Glasgow Haskell Compiler / GHC Commits: bf33ed4a by Vladislav Zavialov at 2023-02-04T13:49:31+03:00 WIP: Visibility subsumption - - - - - 30 changed files: - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Types/Error/Codes.hs - testsuite/tests/dependent/should_compile/T11966.hs - testsuite/tests/indexed-types/should_compile/T15740a.hs - testsuite/tests/saks/should_compile/saks032.hs - testsuite/tests/saks/should_fail/T18863a.stderr - testsuite/tests/typecheck/should_compile/T15079.hs - + testsuite/tests/typecheck/should_fail/T15079_fail_a.hs - + testsuite/tests/typecheck/should_fail/T15079_fail_a.stderr - + testsuite/tests/typecheck/should_fail/T15079_fail_b.hs - + testsuite/tests/typecheck/should_fail/T15079_fail_b.stderr - + testsuite/tests/typecheck/should_fail/T22648a.hs - + testsuite/tests/typecheck/should_fail/T22648a.stderr - + testsuite/tests/typecheck/should_fail/T22648b.hs - + testsuite/tests/typecheck/should_fail/T22648b.stderr - + testsuite/tests/typecheck/should_fail/T22648c.hs - + testsuite/tests/typecheck/should_fail/T22648c.stderr - + testsuite/tests/typecheck/should_fail/T22648v.hs - + testsuite/tests/typecheck/should_fail/T22648v.stderr - + testsuite/tests/typecheck/should_fail/T22648v_ql.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bf33ed4a8bc01d80f184b4a965d0316ea8c0a435 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bf33ed4a8bc01d80f184b4a965d0316ea8c0a435 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Feb 4 12:26:35 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sat, 04 Feb 2023 07:26:35 -0500 Subject: [Git][ghc/ghc][wip/int-index/visibility-subsumption] 15 commits: docs: 9.6 release notes for wasm backend Message-ID: <63de4efb7f5c9_1108fe526487971b5@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/visibility-subsumption at Glasgow Haskell Compiler / GHC Commits: 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 04ddf438 by Vladislav Zavialov at 2023-02-04T15:26:24+03:00 WIP: Visibility subsumption - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/CmmToLlvm/Mangler.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/List/SetOps.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Env.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Stg/Lift/Monad.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/HsType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bf33ed4a8bc01d80f184b4a965d0316ea8c0a435...04ddf438b90914836aebe698a851f8eaaf9706df -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bf33ed4a8bc01d80f184b4a965d0316ea8c0a435...04ddf438b90914836aebe698a851f8eaaf9706df You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Feb 4 14:45:41 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sat, 04 Feb 2023 09:45:41 -0500 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] 2 commits: Better underflow frames Message-ID: <63de6f95f0a28_1108fe526208088d3@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: 8dde2bc2 by Sven Tennie at 2023-02-04T13:39:53+00:00 Better underflow frames - - - - - 0ada16c3 by Sven Tennie at 2023-02-04T14:45:08+00:00 Test underflow frame - - - - - 12 changed files: - libraries/ghc-heap/GHC/Exts/DecodeHeap.hs - libraries/ghc-heap/GHC/Exts/DecodeStack.hs - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs - libraries/ghc-heap/cbits/Stack.cmm - libraries/ghc-heap/tests/TestUtils.hs - libraries/ghc-heap/tests/stack_big_ret.hs - libraries/ghc-heap/tests/stack_misc_closures.hs - libraries/ghc-heap/tests/stack_misc_closures_c.c - libraries/ghc-heap/tests/stack_misc_closures_prim.cmm - libraries/ghc-heap/tests/stack_underflow.hs - utils/deriveConstants/Main.hs Changes: ===================================== libraries/ghc-heap/GHC/Exts/DecodeHeap.hs ===================================== @@ -234,6 +234,7 @@ getClosureDataFromHeapRepPrim getConDesc decodeCCS itbl heapRep pts = do #if __GLASGOW_HASKELL__ >= 811 , stack_marking = FFIClosures.stack_marking fields #endif + , stack = [] }) | otherwise -> fail $ "Expected 0 ptr argument to STACK, found " ===================================== libraries/ghc-heap/GHC/Exts/DecodeStack.hs ===================================== @@ -37,6 +37,7 @@ import GHC.Stack.CloneStack import Prelude import GHC.IO (IO (..)) import Data.Array.Byte +import GHC.Word {- Note [Decoding the stack] ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -156,27 +157,34 @@ foreign import prim "advanceStackFrameIterzh" advanceStackFrameIter# :: StackSna foreign import prim "getInfoTableAddrzh" getInfoTableAddr# :: StackSnapshot# -> Word# -> Addr# +foreign import prim "getStackInfoTableAddrzh" getStackInfoTableAddr# :: StackSnapshot# -> Addr# + getInfoTable :: StackFrameIter -> IO StgInfoTable -getInfoTable StackFrameIter {..} = +getInfoTable StackFrameIter {..} | sfiKind == SfiClosure = let infoTablePtr = Ptr (getInfoTableAddr# stackSnapshot# (wordOffsetToWord# index)) in peekItbl infoTablePtr +getInfoTable StackFrameIter {..} | sfiKind == SfiStack = peekItbl $ Ptr (getStackInfoTableAddr# stackSnapshot#) +getInfoTable StackFrameIter {..} | sfiKind == SfiPrimitive = error "Primitives have no info table!" foreign import prim "getBoxedClosurezh" getBoxedClosure# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Any #) --- -- TODO: Remove this instance (debug only) --- instance Show StackFrameIter where --- show (StackFrameIter {..}) = "StackFrameIter " ++ "(StackSnapshot _" ++ " " ++ show index +foreign import prim "getStackFieldszh" getStackFields# :: StackSnapshot# -> State# RealWorld -> (# State# RealWorld, Word32#, Word8#, Word8# #) + +getStackFields :: StackFrameIter -> IO (Word32, Word8, Word8) +getStackFields StackFrameIter {..} = IO $ \s -> + case getStackFields# stackSnapshot# s of (# s1, sSize#, sDirty#, sMarking# #) + -> (# s1, (W32# sSize#, W8# sDirty#, W8# sMarking#) #) -- | Get an interator starting with the top-most stack frame stackHead :: StackSnapshot -> StackFrameIter -stackHead (StackSnapshot s) = StackFrameIter s 0 False -- GHC stacks are never empty +stackHead (StackSnapshot s) = StackFrameIter s 0 SfiClosure -- GHC stacks are never empty -- | Advance iterator to the next stack frame (if any) advanceStackFrameIter :: StackFrameIter -> Maybe StackFrameIter advanceStackFrameIter (StackFrameIter {..}) = let !(# s', i', hasNext #) = advanceStackFrameIter# stackSnapshot# (wordOffsetToWord# index) in if (I# hasNext) > 0 - then Just $ StackFrameIter s' (primWordToWordOffset i') False + then Just $ StackFrameIter s' (primWordToWordOffset i') SfiClosure else Nothing primWordToWordOffset :: Word# -> WordOffset @@ -191,7 +199,7 @@ wordsToBitmapEntries sfi (b : bs) bitmapSize = mbLastFrame = (listToMaybe . reverse) entries in case mbLastFrame of Just (StackFrameIter {..}) -> - entries ++ wordsToBitmapEntries (StackFrameIter stackSnapshot# (index + 1) False) bs (subtractDecodedBitmapWord bitmapSize) + entries ++ wordsToBitmapEntries (StackFrameIter stackSnapshot# (index + 1) SfiClosure) bs (subtractDecodedBitmapWord bitmapSize) Nothing -> error "This should never happen! Recursion ended not in base case." where subtractDecodedBitmapWord :: Word -> Word @@ -202,12 +210,12 @@ toBitmapEntries _ _ 0 = [] toBitmapEntries sfi@(StackFrameIter {..}) bitmapWord bSize = -- TODO: overriding isPrimitive field is a bit weird. Could be calculated before sfi { - isPrimitive = (bitmapWord .&. 1) /= 0 + sfiKind = if (bitmapWord .&. 1) /= 0 then SfiPrimitive else SfiClosure } - : toBitmapEntries (StackFrameIter stackSnapshot# (index + 1) False) (bitmapWord `shiftR` 1) (bSize - 1) + : toBitmapEntries (StackFrameIter stackSnapshot# (index + 1) SfiClosure) (bitmapWord `shiftR` 1) (bSize - 1) toBitmapPayload :: StackFrameIter -> IO Box -toBitmapPayload sfi | isPrimitive sfi = pure (StackFrameBox sfi) +toBitmapPayload sfi | sfiKind sfi == SfiPrimitive = pure (StackFrameBox sfi) toBitmapPayload sfi = getClosure sfi 0 getClosure :: StackFrameIter -> WordOffset -> IO Box @@ -226,7 +234,7 @@ decodeLargeBitmap getterFun# sfi@(StackFrameIter {..}) relativePayloadOffset = d decodeBitmaps :: StackFrameIter -> WordOffset -> [Word] -> Word -> IO [Box] decodeBitmaps (StackFrameIter {..}) relativePayloadOffset bitmapWords size = - let bes = wordsToBitmapEntries (StackFrameIter stackSnapshot# (index + relativePayloadOffset) False) bitmapWords size + let bes = wordsToBitmapEntries (StackFrameIter stackSnapshot# (index + relativePayloadOffset) SfiClosure) bitmapWords size in mapM toBitmapPayload bes decodeSmallBitmap :: (StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word#, Word# #)) -> StackFrameIter -> WordOffset -> IO [Box] @@ -249,7 +257,21 @@ wordOffsetToWord# :: WordOffset -> Word# wordOffsetToWord# wo = intToWord# (fromIntegral wo) unpackStackFrameIter :: StackFrameIter -> IO Closure -unpackStackFrameIter sfi | isPrimitive sfi = UnknownTypeWordSizedPrimitive <$> (getWord sfi 0) +unpackStackFrameIter sfi | sfiKind sfi == SfiPrimitive = UnknownTypeWordSizedPrimitive <$> (getWord sfi 0) +unpackStackFrameIter sfi | sfiKind sfi == SfiStack = do + info <- getInfoTable sfi + (stack_size', stack_dirty', stack_marking') <- getStackFields sfi + case tipe info of + STACK -> do + let stack' = decodeStack' (StackSnapshot (stackSnapshot# sfi)) + pure $ StackClosure { + info = info, + stack_size = stack_size', + stack_dirty = stack_dirty', + stack_marking = stack_marking', + stack = stack' + } + _ -> error $ "Expected STACK closure, got " ++ show info unpackStackFrameIter sfi = do traceM $ "unpackStackFrameIter - sfi " ++ show sfi info <- getInfoTable sfi @@ -316,10 +338,14 @@ unpackStackFrameIter sfi = do handler = handler' } UNDERFLOW_FRAME -> do - nextChunk' <- getUnderflowFrameNextChunk sfi + (StackSnapshot nextChunk') <- getUnderflowFrameNextChunk sfi pure $ UnderflowFrame { info = info, - nextChunk = nextChunk' + nextChunk = StackFrameBox $ StackFrameIter { + stackSnapshot# = nextChunk', + index = 0, + sfiKind = SfiStack + } } STOP_FRAME -> pure $ StopFrame {info = info} ATOMICALLY_FRAME -> do @@ -363,9 +389,12 @@ toInt# (I# i) = i intToWord# :: Int -> Word# intToWord# i = int2Word# (toInt# i) -decodeStack :: StackSnapshot -> Closure -decodeStack = SimpleStack . decodeStack' - +decodeStack :: StackSnapshot -> IO Closure +decodeStack (StackSnapshot stack#) = unpackStackFrameIter $ StackFrameIter { + stackSnapshot# = stack#, + index = 0, + sfiKind = SfiStack + } decodeStack' :: StackSnapshot -> [Box] decodeStack' s = StackFrameBox (stackHead s) : go (advanceStackFrameIter (stackHead s)) where ===================================== libraries/ghc-heap/GHC/Exts/Heap.hs ===================================== @@ -143,7 +143,7 @@ instance Double# ~ a => HasHeapRep (a :: TYPE 'DoubleRep) where #if MIN_TOOL_VERSION_ghc(9,5,0) instance {-# OVERLAPPING #-} HasHeapRep StackSnapshot# where - getClosureData s# = pure $ decodeStack (StackSnapshot s#) + getClosureData s# = decodeStack (StackSnapshot s#) #endif -- | Get the heap representation of a closure _at this moment_, even if it is @@ -208,5 +208,7 @@ closureSize (StackFrameBox sfi) = unpackStackFrameIter sfi <&> RetFun {..} -> sizeStgRetFunFrame + length retFunPayload -- The one additional word is a pointer to the StgBCO in the closure's payload RetBCO {..} -> sizeStgClosure + 1 + length bcoArgs + -- The one additional word is a pointer to the next stack chunk + UnderflowFrame {} -> sizeStgClosure + 1 _ -> error "Unexpected closure type" #endif ===================================== libraries/ghc-heap/GHC/Exts/Heap/Closures.hs ===================================== @@ -25,6 +25,7 @@ module GHC.Exts.Heap.Closures ( , areBoxesEqual , asBox #if MIN_VERSION_base(4,17,0) + , SfiKind(..) , StackFrameIter(..) #endif ) where @@ -78,10 +79,13 @@ foreign import prim "eqStackSnapshotszh" eqStackSnapshots# :: StackSnapshot# -> -- required, e.g. in 'getBoxedClosureData', the function knows how far it has -- to evaluate the argument. #if MIN_VERSION_base(4,17,0) +data SfiKind = SfiClosure | SfiPrimitive | SfiStack + deriving (Eq, Show) + data StackFrameIter = StackFrameIter { stackSnapshot# :: !StackSnapshot#, index :: !WordOffset, - isPrimitive :: !Bool + sfiKind :: !SfiKind } instance Show StackFrameIter where @@ -360,14 +364,12 @@ data GenClosure b #if __GLASGOW_HASKELL__ >= 811 , stack_marking :: !Word8 #endif + -- | The frames of the stack. Only available if a cloned stack was + -- decoded, otherwise empty. + , stack :: ![b] } #if MIN_TOOL_VERSION_ghc(9,5,0) - -- TODO: I could model stack chunks here (much better). However, I need the - -- code to typecheck, now. - | SimpleStack { - stackClosures :: ![b] - } | UpdateFrame { info :: !StgInfoTable , knownUpdateFrameType :: !UpdateFrameType @@ -402,7 +404,7 @@ data GenClosure b -- TODO: nextChunk could be a CL.Closure, too! (StackClosure) | UnderflowFrame { info :: !StgInfoTable - , nextChunk:: !StackSnapshot + , nextChunk :: !b } | StopFrame @@ -621,7 +623,7 @@ allClosures (BlockingQueueClosure {..}) = [link, blackHole, owner, queue] allClosures (WeakClosure {..}) = [cfinalizers, key, value, finalizer] ++ Data.Foldable.toList weakLink allClosures (OtherClosure {..}) = hvalues #if MIN_TOOL_VERSION_ghc(9,5,0) -allClosures (SimpleStack {..}) = stackClosures +allClosures (StackClosure {..}) = stack allClosures (UpdateFrame {..}) = [updatee] allClosures (CatchFrame {..}) = [handler] allClosures (CatchStmFrame {..}) = [catchFrameCode, handler] ===================================== libraries/ghc-heap/cbits/Stack.cmm ===================================== @@ -3,6 +3,7 @@ #include "Cmm.h" +#if defined(StgStack_marking) advanceStackFrameIterzh (P_ stack, W_ offsetWords) { W_ frameSize; (frameSize) = ccall stackFrameSize(stack, offsetWords); @@ -175,6 +176,12 @@ getInfoTableAddrzh(P_ stack, W_ offsetWords){ return (info); } +getStackInfoTableAddrzh(P_ stack){ + P_ info; + info = %GET_STD_INFO(UNTAG(stack)); + return (info); +} + // Just a cast stackSnapshotToWordzh(P_ stack) { return (stack); @@ -199,5 +206,18 @@ getBoxedClosurezh(P_ stack, W_ offsetWords){ return (box); } +// TODO: Unused? INFO_TABLE_CONSTR(box, 1, 0, 0, CONSTR_1_0, "BOX", "BOX") { foreign "C" barf("BOX object (%p) entered!", R1) never returns; } + +getStackFieldszh(P_ stack){ + bits32 size; + bits8 dirty, marking; + + size = StgStack_stack_size(stack); + dirty = StgStack_dirty(stack); + marking = StgStack_marking(stack); + + return (size, dirty, marking); +} +#endif ===================================== libraries/ghc-heap/tests/TestUtils.hs ===================================== @@ -30,8 +30,8 @@ import Unsafe.Coerce (unsafeCoerce) getDecodedStack :: IO (StackSnapshot, [Closure]) getDecodedStack = do s@(StackSnapshot s#) <- cloneMyStack - (SimpleStack cs) <- getClosureData s# - unboxedCs <- mapM getBoxedClosureData cs + stackClosure <- getClosureData s# + unboxedCs <- mapM getBoxedClosureData (stack stackClosure) pure (s, unboxedCs) assertEqual :: (HasCallStack, Monad m, Show a, Eq a) => a -> a -> m () ===================================== libraries/ghc-heap/tests/stack_big_ret.hs ===================================== @@ -37,8 +37,8 @@ main = do mbStackSnapshot <- readIORef stackRef let stackSnapshot@(StackSnapshot s#) = fromJust mbStackSnapshot - (SimpleStack boxedFrames) <- getClosureData s# - stackFrames <- mapM getBoxedClosureData boxedFrames + stackClosure <- getClosureData s# + stackFrames <- mapM getBoxedClosureData (stack stackClosure) assertStackInvariants stackSnapshot stackFrames assertThat ===================================== libraries/ghc-heap/tests/stack_misc_closures.hs ===================================== @@ -58,6 +58,8 @@ foreign import prim "any_ret_fun_arg_gen_big_framezh" any_ret_fun_arg_gen_big_fr foreign import prim "any_bco_framezh" any_bco_frame# :: SetupFunction +foreign import prim "any_underflow_framezh" any_underflow_frame# :: SetupFunction + foreign import ccall "maxSmallBitmapBits" maxSmallBitmapBits_c :: Word foreign import ccall "belchStack" belchStack# :: StackSnapshot# -> IO () @@ -311,6 +313,30 @@ main = do traceM $ "Test 31" testSize any_bco_frame# 3 traceM $ "Test 32" + test any_underflow_frame# $ + \case + UnderflowFrame {..} -> do + assertEqual (tipe info) UNDERFLOW_FRAME + nextStack <- getBoxedClosureData nextChunk + case nextStack of + StackClosure {..} -> do + assertEqual (tipe info) STACK + assertEqual stack_size 27 + assertEqual stack_dirty 0 + assertEqual stack_marking 0 + nextStackClosures <- mapM getBoxedClosureData stack + assertEqual (length nextStackClosures) 2 + case head nextStackClosures of + RetSmall {..} -> + assertEqual (tipe info) RET_SMALL + e -> error $ "Wrong closure type: " ++ show e + case last nextStackClosures of + StopFrame {..} -> + assertEqual (tipe info) STOP_FRAME + e -> error $ "Wrong closure type: " ++ show e + e -> error $ "Wrong closure type: " ++ show e + e -> error $ "Wrong closure type: " ++ show e + testSize any_underflow_frame# 2 type SetupFunction = State# RealWorld -> (# State# RealWorld, StackSnapshot# #) @@ -326,10 +352,11 @@ test setup assertion = do -- Better fail early, here. performGC traceM $ "test - sn' " ++ show sn - ss@(SimpleStack boxedFrames) <- getClosureData sn# - traceM $ "test - ss" ++ show ss + stackClosure <- getClosureData sn# + traceM $ "test - ss" ++ show stackClosure performGC traceM $ "call getBoxedClosureData" + let boxedFrames = stack stackClosure stack <- mapM getBoxedClosureData boxedFrames performGC assert sn stack @@ -338,8 +365,8 @@ test setup assertion = do let (StackSnapshot sn#) = sn stack' <- getClosureData sn# case stack' of - SimpleStack {..} -> do - !cs <- mapM getBoxedClosureData stackClosures + StackClosure {..} -> do + !cs <- mapM getBoxedClosureData stack assert sn cs _ -> error $ "Unexpected closure type : " ++ show stack' where @@ -364,8 +391,8 @@ entertainGC x = show x ++ entertainGC (x -1) testSize :: HasCallStack => SetupFunction -> Int -> IO () testSize setup expectedSize = do (StackSnapshot sn#) <- getStackSnapshot setup - (SimpleStack boxedFrames) <- getClosureData sn# - assertEqual expectedSize =<< closureSize (head boxedFrames) + stackClosure <- getClosureData sn# + assertEqual expectedSize =<< (closureSize . head . stack) stackClosure -- | Get a `StackSnapshot` from test setup -- ===================================== libraries/ghc-heap/tests/stack_misc_closures_c.c ===================================== @@ -242,6 +242,14 @@ void create_any_bco_frame(Capability *cap, StgStack *stack, StgWord w) { c->payload[1] = (StgClosure *)rts_mkWord(cap, w); } +StgStack *any_ret_small_prim_frame(Capability *cap); + +void create_any_underflow_frame(Capability *cap, StgStack *stack, StgWord w) { + StgUnderflowFrame *underflowF = (StgUnderflowFrame *)stack->sp; + underflowF->info = &stg_stack_underflow_frame_info; + underflowF->next_chunk = any_ret_small_prim_frame(cap); +} + // Import from Sanity.c extern void checkSTACK(StgStack *stack); @@ -355,4 +363,9 @@ StgStack *any_bco_frame(Capability *cap) { &create_any_bco_frame); } +StgStack *any_underflow_frame(Capability *cap) { + return setup(cap, sizeofW(StgUnderflowFrame), + &create_any_underflow_frame); +} + void belchStack(StgStack *stack) { printStack(stack); } ===================================== libraries/ghc-heap/tests/stack_misc_closures_prim.cmm ===================================== @@ -96,6 +96,12 @@ any_bco_framezh() { return (stack); } +any_underflow_framezh() { + P_ stack; + (stack) = ccall any_underflow_frame(MyCapability() "ptr"); + return (stack); +} + INFO_TABLE_RET ( test_small_ret_full_p, RET_SMALL, W_ info_ptr, #if SIZEOF_VOID_P == 4 P_ ptr1, P_ ptr2, P_ ptr3, P_ ptr4, P_ ptr5, P_ ptr6, P_ ptr7, P_ ptr8, P_ ptr9, P_ ptr10, ===================================== libraries/ghc-heap/tests/stack_underflow.hs ===================================== @@ -5,6 +5,7 @@ module Main where import Data.Bool (Bool (True)) import GHC.Exts.DecodeStack +import GHC.Exts.Heap import GHC.Exts.Heap.ClosureTypes import GHC.Exts.Heap.Closures import GHC.Exts.Heap.InfoTable.Types @@ -37,7 +38,9 @@ isUnderflowFrame _ = False assertStackChunksAreDecodable :: HasCallStack => [Closure] -> IO () assertStackChunksAreDecodable s = do let underflowFrames = filter isUnderflowFrame s - let framesOfChunks = map (stackClosures . decodeStack . nextChunk) underflowFrames + stackClosures <- mapM (getBoxedClosureData . nextChunk) underflowFrames + let stackBoxes = map stack stackClosures + framesOfChunks <- sequence (map (mapM getBoxedClosureData) stackBoxes) assertThat "No empty stack chunks" (== True) ===================================== utils/deriveConstants/Main.hs ===================================== @@ -476,6 +476,7 @@ wanteds os = concat ,closureFieldOffset Both "StgStack" "stack" ,closureField C "StgStack" "stack_size" ,closureField C "StgStack" "dirty" + ,closureField C "StgStack" "marking" ,structSize C "StgTSOProfInfo" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fe83579e946a3d6a8316bddccf554f51700529af...0ada16c38d99c7416ac027189f600e26f126d5d5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fe83579e946a3d6a8316bddccf554f51700529af...0ada16c38d99c7416ac027189f600e26f126d5d5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Feb 4 15:35:43 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sat, 04 Feb 2023 10:35:43 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/decode_cloned_stack_save Message-ID: <63de7b4f9e03d_1108fe5265c8163b8@gitlab.mail> Sven Tennie pushed new branch wip/decode_cloned_stack_save at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/decode_cloned_stack_save You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Feb 4 15:44:17 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sat, 04 Feb 2023 10:44:17 -0500 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] ghc-heap: Decode StgStack and its frames Message-ID: <63de7d51e8961_1108fe2b215ec88166b3@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: d5eca620 by Sven Tennie at 2023-02-04T15:39:50+00:00 ghc-heap: Decode StgStack and its frames Previously, ghc-heap could only decode heap closures. The approach is explained in detail in note [Decoding the stack]. - - - - - 30 changed files: - compile_flags.txt - libraries/base/GHC/Stack/CloneStack.hs - + libraries/ghc-heap/GHC/Exts/DecodeHeap.hs - + libraries/ghc-heap/GHC/Exts/DecodeStack.hs - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs - libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc - libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc - + libraries/ghc-heap/GHC/Exts/StackConstants.hsc - + libraries/ghc-heap/cbits/Stack.c - + libraries/ghc-heap/cbits/Stack.cmm - libraries/ghc-heap/ghc-heap.cabal.in - libraries/ghc-heap/tests/TestUtils.hs - libraries/ghc-heap/tests/all.T - + libraries/ghc-heap/tests/stack_big_ret.hs - + libraries/ghc-heap/tests/stack_misc_closures.hs - + libraries/ghc-heap/tests/stack_misc_closures_c.c - + libraries/ghc-heap/tests/stack_misc_closures_prim.cmm - + libraries/ghc-heap/tests/stack_stm_frames.hs - + libraries/ghc-heap/tests/stack_underflow.hs - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/Run.hs - rts/Heap.c - rts/PrimOps.cmm - rts/Printer.c - rts/RtsSymbols.c - rts/include/rts/storage/InfoTables.h - rts/sm/Sanity.c - rts/sm/Sanity.h - utils/deriveConstants/Main.hs Changes: ===================================== compile_flags.txt ===================================== @@ -2,4 +2,5 @@ -Irts -Irts/include -I.hie-bios/stage0/lib - +-I_build/stage1/rts/build/include/ +-DDEBUG ===================================== libraries/base/GHC/Stack/CloneStack.hs ===================================== @@ -26,7 +26,7 @@ import Control.Concurrent.MVar import Data.Maybe (catMaybes) import Foreign import GHC.Conc.Sync -import GHC.Exts (Int (I#), RealWorld, StackSnapshot#, ThreadId#, Array#, sizeofArray#, indexArray#, State#, StablePtr#) +import GHC.Exts (Int (I#), RealWorld, StackSnapshot#, ThreadId#, Array#, sizeofArray#, indexArray#, State#, StablePtr#, Word#, unsafeCoerce#, eqWord#, isTrue#) import GHC.IO (IO (..)) import GHC.InfoProv (InfoProv (..), InfoProvEnt, ipLoc, ipeProv, peekInfoProv) import GHC.Stable @@ -36,6 +36,15 @@ import GHC.Stable -- @since 4.17.0.0 data StackSnapshot = StackSnapshot !StackSnapshot# + +-- TODO: Cast to Addr representation instead? +instance Eq StackSnapshot where + (StackSnapshot s1#) == (StackSnapshot s2#) = isTrue# (((unsafeCoerce# s1#) :: Word#) `eqWord#` ((unsafeCoerce# s2#) :: Word#)) + +-- TODO: Show and Eq instances are mainly here to fulfill Closure deriving requirements +-- instance Show StackSnapshot where +-- show _ = "StackSnapshot" + foreign import prim "stg_decodeStackzh" decodeStack# :: StackSnapshot# -> State# RealWorld -> (# State# RealWorld, Array# (Ptr InfoProvEnt) #) foreign import prim "stg_cloneMyStackzh" cloneMyStack# :: State# RealWorld -> (# State# RealWorld, StackSnapshot# #) ===================================== libraries/ghc-heap/GHC/Exts/DecodeHeap.hs ===================================== @@ -0,0 +1,244 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE UnliftedFFITypes #-} + +module GHC.Exts.DecodeHeap where +import Prelude +import GHC.Exts.Heap.Closures +import GHC.Exts.Heap.ClosureTypes +import GHC.Exts.Heap.Constants +import GHC.Exts.Heap.ProfInfo.Types +#if defined(PROFILING) +import GHC.Exts.Heap.InfoTableProf +#else +import GHC.Exts.Heap.InfoTable +#endif +import GHC.Exts.Heap.Utils +import qualified GHC.Exts.Heap.FFIClosures as FFIClosures +import qualified GHC.Exts.Heap.ProfInfo.PeekProfInfo as PPI + +import Data.Bits +import Foreign +import GHC.Exts + +-- | Convert an unpacked heap object, to a `GenClosure b`. The inputs to this +-- function can be generated from a heap object using `unpackClosure#`. +getClosureDataFromHeapRep :: ByteArray# -> Ptr StgInfoTable -> [b] -> IO (GenClosure b) +getClosureDataFromHeapRep heapRep infoTablePtr pts = do + itbl <- peekItbl infoTablePtr + getClosureDataFromHeapRepPrim (dataConNames infoTablePtr) PPI.peekTopCCS itbl heapRep pts + +getClosureDataFromHeapRepPrim + :: IO (String, String, String) + -- ^ A continuation used to decode the constructor description field, + -- in ghc-debug this code can lead to segfaults because dataConNames + -- will dereference a random part of memory. + -> (Ptr a -> IO (Maybe CostCentreStack)) + -- ^ A continuation which is used to decode a cost centre stack + -- In ghc-debug, this code will need to call back into the debuggee to + -- fetch the representation of the CCS before decoding it. Using + -- `peekTopCCS` for this argument can lead to segfaults in ghc-debug as + -- the CCS argument will point outside the copied closure. + -> StgInfoTable + -- ^ The `StgInfoTable` of the closure, extracted from the heap + -- representation. + -> ByteArray# + -- ^ Heap representation of the closure as returned by `unpackClosure#`. + -- This includes all of the object including the header, info table + -- pointer, pointer data, and non-pointer data. The ByteArray# may be + -- pinned or unpinned. + -> [b] + -- ^ Pointers in the payload of the closure, extracted from the heap + -- representation as returned by `collect_pointers()` in `Heap.c`. The type + -- `b` is some representation of a pointer e.g. `Any` or `Ptr Any`. + -> IO (GenClosure b) + -- ^ Heap representation of the closure. +getClosureDataFromHeapRepPrim getConDesc decodeCCS itbl heapRep pts = do + let -- heapRep as a list of words. + rawHeapWords :: [Word] + rawHeapWords = [W# (indexWordArray# heapRep i) | I# i <- [0.. end] ] + where + nelems = I# (sizeofByteArray# heapRep) `div` wORD_SIZE + end = fromIntegral nelems - 1 + + -- Just the payload of rawHeapWords (no header). + payloadWords :: [Word] + payloadWords = drop (closureTypeHeaderSize (tipe itbl)) rawHeapWords + + -- The non-pointer words in the payload. Only valid for closures with a + -- "pointers first" layout. Not valid for bit field layout. + npts :: [Word] + npts = drop (closureTypeHeaderSize (tipe itbl) + length pts) rawHeapWords + case tipe itbl of + t | t >= CONSTR && t <= CONSTR_NOCAF -> do + (p, m, n) <- getConDesc + pure $ ConstrClosure itbl pts npts p m n + + t | t >= THUNK && t <= THUNK_STATIC -> do + pure $ ThunkClosure itbl pts npts + + THUNK_SELECTOR -> case pts of + [] -> fail "Expected at least 1 ptr argument to THUNK_SELECTOR" + hd : _ -> pure $ SelectorClosure itbl hd + + t | t >= FUN && t <= FUN_STATIC -> do + pure $ FunClosure itbl pts npts + + AP -> case pts of + [] -> fail "Expected at least 1 ptr argument to AP" + hd : tl -> case payloadWords of + -- We expect at least the arity, n_args, and fun fields + splitWord : _ : _ -> + pure $ APClosure itbl +#if defined(WORDS_BIGENDIAN) + (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2)) + (fromIntegral splitWord) +#else + (fromIntegral splitWord) + (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2)) +#endif + hd tl + _ -> fail "Expected at least 2 raw words to AP" + + PAP -> case pts of + [] -> fail "Expected at least 1 ptr argument to PAP" + hd : tl -> case payloadWords of + -- We expect at least the arity, n_args, and fun fields + splitWord : _ : _ -> + pure $ PAPClosure itbl +#if defined(WORDS_BIGENDIAN) + (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2)) + (fromIntegral splitWord) +#else + (fromIntegral splitWord) + (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2)) +#endif + hd tl + _ -> fail "Expected at least 2 raw words to PAP" + + AP_STACK -> case pts of + [] -> fail "Expected at least 1 ptr argument to AP_STACK" + hd : tl -> pure $ APStackClosure itbl hd tl + + IND -> case pts of + [] -> fail "Expected at least 1 ptr argument to IND" + hd : _ -> pure $ IndClosure itbl hd + + IND_STATIC -> case pts of + [] -> fail "Expected at least 1 ptr argument to IND_STATIC" + hd : _ -> pure $ IndClosure itbl hd + + BLACKHOLE -> case pts of + [] -> fail "Expected at least 1 ptr argument to BLACKHOLE" + hd : _ -> pure $ BlackholeClosure itbl hd + + BCO -> case pts of + pts0 : pts1 : pts2 : _ -> case payloadWords of + _ : _ : _ : splitWord : payloadRest -> + pure $ BCOClosure itbl pts0 pts1 pts2 +#if defined(WORDS_BIGENDIAN) + (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2)) + (fromIntegral splitWord) +#else + (fromIntegral splitWord) + (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2)) +#endif + payloadRest + _ -> fail $ "Expected at least 4 words to BCO, found " + ++ show (length payloadWords) + _ -> fail $ "Expected at least 3 ptr argument to BCO, found " + ++ show (length pts) + + ARR_WORDS -> case payloadWords of + [] -> fail $ "Expected at least 1 words to ARR_WORDS, found " + ++ show (length payloadWords) + hd : tl -> pure $ ArrWordsClosure itbl hd tl + + t | t >= MUT_ARR_PTRS_CLEAN && t <= MUT_ARR_PTRS_FROZEN_CLEAN -> case payloadWords of + p0 : p1 : _ -> pure $ MutArrClosure itbl p0 p1 pts + _ -> fail $ "Expected at least 2 words to MUT_ARR_PTRS_* " + ++ "found " ++ show (length payloadWords) + + t | t >= SMALL_MUT_ARR_PTRS_CLEAN && t <= SMALL_MUT_ARR_PTRS_FROZEN_CLEAN -> case payloadWords of + [] -> fail $ "Expected at least 1 word to SMALL_MUT_ARR_PTRS_* " + ++ "found " ++ show (length payloadWords) + hd : _ -> pure $ SmallMutArrClosure itbl hd pts + + t | t == MUT_VAR_CLEAN || t == MUT_VAR_DIRTY -> case pts of + [] -> fail $ "Expected at least 1 words to MUT_VAR, found " + ++ show (length pts) + hd : _ -> pure $ MutVarClosure itbl hd + + t | t == MVAR_CLEAN || t == MVAR_DIRTY -> case pts of + pts0 : pts1 : pts2 : _ -> pure $ MVarClosure itbl pts0 pts1 pts2 + _ -> fail $ "Expected at least 3 ptrs to MVAR, found " + ++ show (length pts) + + BLOCKING_QUEUE -> + pure $ OtherClosure itbl pts rawHeapWords + + WEAK -> case pts of + pts0 : pts1 : pts2 : pts3 : rest -> pure $ WeakClosure + { info = itbl + , cfinalizers = pts0 + , key = pts1 + , value = pts2 + , finalizer = pts3 + , weakLink = case rest of + [] -> Nothing + [p] -> Just p + _ -> error $ "Expected 4 or 5 words in WEAK, but found more: " ++ show (length pts) + } + _ -> error $ "Expected 4 or 5 words in WEAK, but found less: " ++ show (length pts) + TSO | ( u_lnk : u_gbl_lnk : tso_stack : u_trec : u_blk_ex : u_bq : other) <- pts + -> withArray rawHeapWords (\ptr -> do + fields <- FFIClosures.peekTSOFields decodeCCS ptr + pure $ TSOClosure + { info = itbl + , link = u_lnk + , global_link = u_gbl_lnk + , tsoStack = tso_stack + , trec = u_trec + , blocked_exceptions = u_blk_ex + , bq = u_bq + , thread_label = case other of + [tl] -> Just tl + [] -> Nothing + _ -> error $ "thead_label:Expected 0 or 1 extra arguments" + , what_next = FFIClosures.tso_what_next fields + , why_blocked = FFIClosures.tso_why_blocked fields + , flags = FFIClosures.tso_flags fields + , threadId = FFIClosures.tso_threadId fields + , saved_errno = FFIClosures.tso_saved_errno fields + , tso_dirty = FFIClosures.tso_dirty fields + , alloc_limit = FFIClosures.tso_alloc_limit fields + , tot_stack_size = FFIClosures.tso_tot_stack_size fields + , prof = FFIClosures.tso_prof fields + }) + | otherwise + -> fail $ "Expected at least 6 ptr arguments to TSO, found " + ++ show (length pts) + STACK + | [] <- pts + -> withArray rawHeapWords (\ptr -> do + fields <- FFIClosures.peekStackFields ptr + pure $ StackClosure + { info = itbl + , stack_size = FFIClosures.stack_size fields + , stack_dirty = FFIClosures.stack_dirty fields +#if __GLASGOW_HASKELL__ >= 811 + , stack_marking = FFIClosures.stack_marking fields +#endif + , stack = [] + }) + | otherwise + -> fail $ "Expected 0 ptr argument to STACK, found " + ++ show (length pts) + + _ -> + pure $ UnsupportedClosure itbl ===================================== libraries/ghc-heap/GHC/Exts/DecodeStack.hs ===================================== @@ -0,0 +1,406 @@ +{-# LANGUAGE CPP #-} +#if MIN_TOOL_VERSION_ghc(9,5,0) +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedFFITypes #-} + +-- TODO: Find better place than top level. Re-export from top-level? +module GHC.Exts.DecodeStack + ( decodeStack, + unpackStackFrameIter + ) +where + +import Data.Bits +import Data.Maybe +-- TODO: Remove before releasing +import Debug.Trace +import Foreign +import GHC.Exts +import GHC.Exts.Heap.ClosureTypes +import GHC.Exts.Heap.Closures +import GHC.Exts.Heap.Constants (wORD_SIZE_IN_BITS) +import GHC.Exts.Heap.InfoTable +import GHC.Exts.StackConstants +import GHC.Stack.CloneStack +import Prelude +import GHC.IO (IO (..)) +import Data.Array.Byte +import GHC.Word + +{- Note [Decoding the stack] + ~~~~~~~~~~~~~~~~~~~~~~~~~ + +The stack is represented by a chain of StgStack closures. Each of these closures +is subject to garbage collection. I.e. they can be moved in memory (in a +simplified perspective) at any time. + +The array of closures inside an StgStack (that makeup the execution stack; the +stack frames) is moved as bare memory by the garbage collector. References +(pointers) to stack frames are not updated. + +As the StgStack closure is moved as whole, the relative offsets inside it stay +the same. (Though, the absolute addresses change!) + +Stack frame iterator +==================== + +A stack frame interator (StackFrameIter) consists of a StackSnapshot# and a +relative offset into the the array of stack frames (StgStack->stack). The +StackSnapshot# represents a StgStack closure. It is updated by the garbage +collector when the stack closure is moved. + +The relative offset describes the location of a stack frame. As stack frames +come in various sizes, one cannot simply step over the stack array with a +constant offset. + +The head of the stack frame array has offset 0. To traverse the stack frames the +latest stack frame's offset is incremented by the closure size. The unit of the +offset is machine words (32bit or 64bit). + +Additionally, StackFrameIter contains a flag (isPrimitive) to indicate if a +location on the stack should be interpreted as plain data word (in contrast to +being a closure or a pointer to a closure.) It's used when bitmap encoded +arguments are interpreted. + +Boxes +===== + +As references into the stack frame array aren't updated by the garbage collector, +creating a Box with a pointer (address) to a stack frame would break as soon as +the StgStack closure is moved. + +To deal with this another kind of Box is introduced: A StackFrameBox contains a +stack frame iterator for a decoded stack frame or it's payload. + +Heap-represented closures referenced by stack frames are boxed the usual way, +with a Box that contains a pointer to the closure as it's payload. In +Haskell-land this means: A Box which contains the closure. + +Technical details +================= + +- All access to StgStack/StackSnapshot# closures is made through Cmm code. This + keeps the closure from being moved by the garbage collector during the + operation. + +- As StgStacks are mainly used in Cmm and C code, much of the decoding logic is + implemented in Cmm and C. It's just easier to reuse existing helper macros and + functions, than reinventing them in Haskell. + +- Offsets and sizes of closures are imported from DerivedConstants.h via HSC. + This keeps the code very portable. +-} + +foreign import prim "derefStackWordzh" derefStackWord# :: StackSnapshot# -> Word# -> Word# + +derefStackWord :: StackFrameIter -> Word +derefStackWord (StackFrameIter {..}) = W# (derefStackWord# stackSnapshot# (wordOffsetToWord# index)) + +foreign import prim "getUpdateFrameTypezh" getUpdateFrameType# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word# #) + +getUpdateFrameType :: StackFrameIter -> IO UpdateFrameType +getUpdateFrameType (StackFrameIter {..}) = (toEnum . fromInteger . toInteger) <$> IO (\s -> + case (getUpdateFrameType# stackSnapshot# (wordOffsetToWord# index) s) of (# s1, uft# #) -> (# s1, W# uft# #)) + +foreign import prim "getUnderflowFrameNextChunkzh" getUnderflowFrameNextChunk# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, StackSnapshot# #) + +getUnderflowFrameNextChunk :: StackFrameIter -> IO StackSnapshot +getUnderflowFrameNextChunk (StackFrameIter {..}) = IO $ \s -> + case getUnderflowFrameNextChunk# stackSnapshot# (wordOffsetToWord# index) s of + (# s1, stack# #) -> (# s1, StackSnapshot stack# #) + +foreign import prim "getWordzh" getWord# :: StackSnapshot# -> Word# -> Word# -> State# RealWorld -> (# State# RealWorld, Word# #) + +foreign import prim "getAddrzh" getAddr# :: StackSnapshot# -> Word# -> Addr# + +getWord :: StackFrameIter -> WordOffset -> IO Word +getWord (StackFrameIter {..}) relativeOffset = IO $ \s -> + case getWord# stackSnapshot# (wordOffsetToWord# index) (wordOffsetToWord# relativeOffset) s of + (# s1, w# #) -> (# s1, W# w# #) + +foreign import prim "getRetFunTypezh" getRetFunType# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word# #) + +-- TODO: Could use getWord +getRetFunType :: StackFrameIter -> IO RetFunType +getRetFunType (StackFrameIter {..}) = (toEnum . fromInteger . toInteger) <$> IO (\s -> + case (getRetFunType# stackSnapshot# (wordOffsetToWord# index) s) of (# s1, rft# #) -> (# s1, W# rft# #)) + +foreign import prim "getLargeBitmapzh" getLargeBitmap# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, ByteArray#, Word# #) + +foreign import prim "getBCOLargeBitmapzh" getBCOLargeBitmap# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, ByteArray#, Word# #) + +foreign import prim "getRetFunLargeBitmapzh" getRetFunLargeBitmap# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, ByteArray#, Word# #) + +foreign import prim "getSmallBitmapzh" getSmallBitmap# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word#, Word# #) + +foreign import prim "getRetSmallSpecialTypezh" getRetSmallSpecialType# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word# #) + +getRetSmallSpecialType :: StackFrameIter -> IO SpecialRetSmall +getRetSmallSpecialType (StackFrameIter {..}) = (toEnum . fromInteger . toInteger) <$> IO (\s -> + case (getRetSmallSpecialType# stackSnapshot# (wordOffsetToWord# index) s) of (# s1, rft# #) -> (# s1, W# rft# #)) + +foreign import prim "getRetFunSmallBitmapzh" getRetFunSmallBitmap# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word#, Word# #) + +foreign import prim "advanceStackFrameIterzh" advanceStackFrameIter# :: StackSnapshot# -> Word# -> (# StackSnapshot#, Word#, Int# #) + +foreign import prim "getInfoTableAddrzh" getInfoTableAddr# :: StackSnapshot# -> Word# -> Addr# + +foreign import prim "getStackInfoTableAddrzh" getStackInfoTableAddr# :: StackSnapshot# -> Addr# + +getInfoTable :: StackFrameIter -> IO StgInfoTable +getInfoTable StackFrameIter {..} | sfiKind == SfiClosure = + let infoTablePtr = Ptr (getInfoTableAddr# stackSnapshot# (wordOffsetToWord# index)) + in peekItbl infoTablePtr +getInfoTable StackFrameIter {..} | sfiKind == SfiStack = peekItbl $ Ptr (getStackInfoTableAddr# stackSnapshot#) +getInfoTable StackFrameIter {..} | sfiKind == SfiPrimitive = error "Primitives have no info table!" + +foreign import prim "getBoxedClosurezh" getBoxedClosure# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Any #) + +foreign import prim "getStackFieldszh" getStackFields# :: StackSnapshot# -> State# RealWorld -> (# State# RealWorld, Word32#, Word8#, Word8# #) + +getStackFields :: StackFrameIter -> IO (Word32, Word8, Word8) +getStackFields StackFrameIter {..} = IO $ \s -> + case getStackFields# stackSnapshot# s of (# s1, sSize#, sDirty#, sMarking# #) + -> (# s1, (W32# sSize#, W8# sDirty#, W8# sMarking#) #) + +-- | Get an interator starting with the top-most stack frame +stackHead :: StackSnapshot -> StackFrameIter +stackHead (StackSnapshot s) = StackFrameIter s 0 SfiClosure -- GHC stacks are never empty + +-- | Advance iterator to the next stack frame (if any) +advanceStackFrameIter :: StackFrameIter -> Maybe StackFrameIter +advanceStackFrameIter (StackFrameIter {..}) = + let !(# s', i', hasNext #) = advanceStackFrameIter# stackSnapshot# (wordOffsetToWord# index) + in if (I# hasNext) > 0 + then Just $ StackFrameIter s' (primWordToWordOffset i') SfiClosure + else Nothing + +primWordToWordOffset :: Word# -> WordOffset +primWordToWordOffset w# = fromIntegral (W# w#) + +wordsToBitmapEntries :: StackFrameIter -> [Word] -> Word -> [StackFrameIter] +wordsToBitmapEntries _ [] 0 = [] +wordsToBitmapEntries _ [] i = error $ "Invalid state: Empty list, size " ++ show i +wordsToBitmapEntries _ l 0 = error $ "Invalid state: Size 0, list " ++ show l +wordsToBitmapEntries sfi (b : bs) bitmapSize = + let entries = toBitmapEntries sfi b (min bitmapSize (fromIntegral wORD_SIZE_IN_BITS)) + mbLastFrame = (listToMaybe . reverse) entries + in case mbLastFrame of + Just (StackFrameIter {..}) -> + entries ++ wordsToBitmapEntries (StackFrameIter stackSnapshot# (index + 1) SfiClosure) bs (subtractDecodedBitmapWord bitmapSize) + Nothing -> error "This should never happen! Recursion ended not in base case." + where + subtractDecodedBitmapWord :: Word -> Word + subtractDecodedBitmapWord bSize = fromIntegral $ max 0 ((fromIntegral bSize) - wORD_SIZE_IN_BITS) + +toBitmapEntries :: StackFrameIter -> Word -> Word -> [StackFrameIter] +toBitmapEntries _ _ 0 = [] +toBitmapEntries sfi@(StackFrameIter {..}) bitmapWord bSize = + -- TODO: overriding isPrimitive field is a bit weird. Could be calculated before + sfi { + sfiKind = if (bitmapWord .&. 1) /= 0 then SfiPrimitive else SfiClosure + } + : toBitmapEntries (StackFrameIter stackSnapshot# (index + 1) SfiClosure) (bitmapWord `shiftR` 1) (bSize - 1) + +toBitmapPayload :: StackFrameIter -> IO Box +toBitmapPayload sfi | sfiKind sfi == SfiPrimitive = pure (StackFrameBox sfi) +toBitmapPayload sfi = getClosure sfi 0 + +getClosure :: StackFrameIter -> WordOffset -> IO Box +getClosure sfi at StackFrameIter {..} relativeOffset = trace ("getClosure " ++ show sfi ++ " " ++ show relativeOffset) $ + IO $ \s -> + case (getBoxedClosure# stackSnapshot# (wordOffsetToWord# (index + relativeOffset)) s) of (# s1, ptr #) -> + (# s1, Box ptr #) + +decodeLargeBitmap :: (StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, ByteArray#, Word# #)) -> StackFrameIter -> WordOffset -> IO [Box] +decodeLargeBitmap getterFun# sfi@(StackFrameIter {..}) relativePayloadOffset = do + (bitmapArray, size) <- IO $ \s -> + case getterFun# stackSnapshot# (wordOffsetToWord# index) s of + (# s1, ba#, s# #) -> (# s1, (ByteArray ba#, W# s#) #) + let bitmapWords :: [Word] = byteArrayToList bitmapArray + decodeBitmaps sfi relativePayloadOffset bitmapWords size + +decodeBitmaps :: StackFrameIter -> WordOffset -> [Word] -> Word -> IO [Box] +decodeBitmaps (StackFrameIter {..}) relativePayloadOffset bitmapWords size = + let bes = wordsToBitmapEntries (StackFrameIter stackSnapshot# (index + relativePayloadOffset) SfiClosure) bitmapWords size + in mapM toBitmapPayload bes + +decodeSmallBitmap :: (StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word#, Word# #)) -> StackFrameIter -> WordOffset -> IO [Box] +decodeSmallBitmap getterFun# sfi@(StackFrameIter {..}) relativePayloadOffset = do + (bitmap, size) <- IO $ \s -> + case getterFun# stackSnapshot# (wordOffsetToWord# index) s of + (# s1, b# , s# #) -> (# s1, (W# b# , W# s#) #) + let bitmapWords = if size > 0 then [bitmap] else [] + decodeBitmaps sfi relativePayloadOffset bitmapWords size + +byteArrayToList :: ByteArray -> [Word] +byteArrayToList (ByteArray bArray) = go 0 + where + go i + | i < maxIndex = (W# (indexWordArray# bArray (toInt# i))) : (go (i + 1)) + | otherwise = [] + maxIndex = sizeofByteArray bArray `quot` sizeOf (undefined :: Word) + +wordOffsetToWord# :: WordOffset -> Word# +wordOffsetToWord# wo = intToWord# (fromIntegral wo) + +unpackStackFrameIter :: StackFrameIter -> IO Closure +unpackStackFrameIter sfi | sfiKind sfi == SfiPrimitive = UnknownTypeWordSizedPrimitive <$> (getWord sfi 0) +unpackStackFrameIter sfi | sfiKind sfi == SfiStack = do + info <- getInfoTable sfi + (stack_size', stack_dirty', stack_marking') <- getStackFields sfi + case tipe info of + STACK -> do + let stack' = decodeStack' (StackSnapshot (stackSnapshot# sfi)) + pure $ StackClosure { + info = info, + stack_size = stack_size', + stack_dirty = stack_dirty', + stack_marking = stack_marking', + stack = stack' + } + _ -> error $ "Expected STACK closure, got " ++ show info +unpackStackFrameIter sfi = do + traceM $ "unpackStackFrameIter - sfi " ++ show sfi + info <- getInfoTable sfi + res <- unpackStackFrameIter' info + traceM $ "unpackStackFrameIter - unpacked " ++ show res + pure res + where + unpackStackFrameIter' :: StgInfoTable -> IO Closure + unpackStackFrameIter' info = + case tipe info of + RET_BCO -> do + bco' <- getClosure sfi offsetStgClosurePayload + -- The arguments begin directly after the payload's one element + bcoArgs' <- decodeLargeBitmap getBCOLargeBitmap# sfi (offsetStgClosurePayload + 1) + pure $ RetBCO + { info = info, + bco = bco', + bcoArgs = bcoArgs' + } + RET_SMALL -> + trace "RET_SMALL" $ do + payload' <- decodeSmallBitmap getSmallBitmap# sfi offsetStgClosurePayload + knownRetSmallType' <- getRetSmallSpecialType sfi + pure $ RetSmall + { info = info, + knownRetSmallType = knownRetSmallType', + payload = payload' + } + RET_BIG -> do + payload' <- decodeLargeBitmap getLargeBitmap# sfi offsetStgClosurePayload + pure $ RetBig + { info = info, + payload = payload' + } + RET_FUN -> do + retFunType' <- getRetFunType sfi + retFunSize' <- getWord sfi offsetStgRetFunFrameSize + retFunFun' <- getClosure sfi offsetStgRetFunFrameFun + retFunPayload' <- + if retFunType' == ARG_GEN_BIG + then decodeLargeBitmap getRetFunLargeBitmap# sfi offsetStgRetFunFramePayload + else decodeSmallBitmap getRetFunSmallBitmap# sfi offsetStgRetFunFramePayload + pure $ RetFun + { info = info, + retFunType = retFunType', + retFunSize = retFunSize', + retFunFun = retFunFun', + retFunPayload = retFunPayload' + } + UPDATE_FRAME -> do + updatee' <- getClosure sfi offsetStgUpdateFrameUpdatee + knownUpdateFrameType' <- getUpdateFrameType sfi + pure $ UpdateFrame + { info = info, + knownUpdateFrameType = knownUpdateFrameType', + updatee = updatee' + } + CATCH_FRAME -> do + exceptions_blocked' <- getWord sfi offsetStgCatchFrameExceptionsBlocked + handler' <- getClosure sfi offsetStgCatchFrameHandler + pure $ CatchFrame + { info = info, + exceptions_blocked = exceptions_blocked', + handler = handler' + } + UNDERFLOW_FRAME -> do + (StackSnapshot nextChunk') <- getUnderflowFrameNextChunk sfi + pure $ UnderflowFrame + { info = info, + nextChunk = StackFrameBox $ StackFrameIter { + stackSnapshot# = nextChunk', + index = 0, + sfiKind = SfiStack + } + } + STOP_FRAME -> pure $ StopFrame {info = info} + ATOMICALLY_FRAME -> do + atomicallyFrameCode' <- getClosure sfi offsetStgAtomicallyFrameCode + result' <- getClosure sfi offsetStgAtomicallyFrameResult + pure $ AtomicallyFrame + { info = info, + atomicallyFrameCode = atomicallyFrameCode', + result = result' + } + CATCH_RETRY_FRAME -> do + running_alt_code' <- getWord sfi offsetStgCatchRetryFrameRunningAltCode + first_code' <- getClosure sfi offsetStgCatchRetryFrameRunningFirstCode + alt_code' <- getClosure sfi offsetStgCatchRetryFrameAltCode + pure $ CatchRetryFrame + { info = info, + running_alt_code = running_alt_code', + first_code = first_code', + alt_code = alt_code' + } + CATCH_STM_FRAME -> do + catchFrameCode' <- getClosure sfi offsetStgCatchSTMFrameCode + handler' <- getClosure sfi offsetStgCatchSTMFrameHandler + pure $ CatchStmFrame + { info = info, + catchFrameCode = catchFrameCode', + handler = handler' + } + x -> error $ "Unexpected closure type on stack: " ++ show x + +-- | Size of the byte array in bytes. +-- Copied from `primitive` +sizeofByteArray :: ByteArray# -> Int +{-# INLINE sizeofByteArray #-} +sizeofByteArray arr# = I# (sizeofByteArray# arr#) + +-- | Unbox 'Int#' from 'Int' +toInt# :: Int -> Int# +toInt# (I# i) = i + +intToWord# :: Int -> Word# +intToWord# i = int2Word# (toInt# i) + +decodeStack :: StackSnapshot -> IO Closure +decodeStack (StackSnapshot stack#) = unpackStackFrameIter $ StackFrameIter { + stackSnapshot# = stack#, + index = 0, + sfiKind = SfiStack + } +decodeStack' :: StackSnapshot -> [Box] +decodeStack' s = StackFrameBox (stackHead s) : go (advanceStackFrameIter (stackHead s)) + where + go :: Maybe StackFrameIter -> [Box] + go Nothing = [] + go (Just sfi) = (StackFrameBox sfi) : go (advanceStackFrameIter sfi) +#else +module GHC.Exts.DecodeStack where +#endif ===================================== libraries/ghc-heap/GHC/Exts/Heap.hs ===================================== @@ -7,6 +7,10 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE BangPatterns #-} +#if MIN_TOOL_VERSION_ghc(9,5,0) +{-# LANGUAGE RecordWildCards #-} +#endif {-# LANGUAGE UnliftedFFITypes #-} {-| @@ -27,6 +31,9 @@ module GHC.Exts.Heap ( , PrimType(..) , WhatNext(..) , WhyBlocked(..) + , UpdateFrameType(..) + , SpecialRetSmall(..) + , RetFunType(..) , TsoFlags(..) , HasHeapRep(getClosureData) , getClosureDataFromHeapRep @@ -50,6 +57,7 @@ module GHC.Exts.Heap ( -- * Closure inspection , getBoxedClosureData , allClosures + , closureSize -- * Boxes , Box(..) @@ -60,22 +68,25 @@ module GHC.Exts.Heap ( import Prelude import GHC.Exts.Heap.Closures import GHC.Exts.Heap.ClosureTypes -import GHC.Exts.Heap.Constants import GHC.Exts.Heap.ProfInfo.Types #if defined(PROFILING) import GHC.Exts.Heap.InfoTableProf #else import GHC.Exts.Heap.InfoTable #endif -import GHC.Exts.Heap.Utils -import qualified GHC.Exts.Heap.FFIClosures as FFIClosures -import qualified GHC.Exts.Heap.ProfInfo.PeekProfInfo as PPI +import GHC.Exts.DecodeHeap -import Data.Bits -import Foreign import GHC.Exts import GHC.Int import GHC.Word +#if MIN_TOOL_VERSION_ghc(9,5,0) +import GHC.Stack.CloneStack +import GHC.Exts.DecodeStack +import GHC.Exts.StackConstants +import Data.Functor +import Debug.Trace +#endif + #include "ghcconfig.h" @@ -130,6 +141,11 @@ instance Double# ~ a => HasHeapRep (a :: TYPE 'DoubleRep) where getClosureData x = return $ DoubleClosure { ptipe = PDouble, doubleVal = D# x } +#if MIN_TOOL_VERSION_ghc(9,5,0) +instance {-# OVERLAPPING #-} HasHeapRep StackSnapshot# where + getClosureData s# = decodeStack (StackSnapshot s#) +#endif + -- | Get the heap representation of a closure _at this moment_, even if it is -- unevaluated or an indirection or other exotic stuff. Beware when passing -- something to this function, the same caveats as for @@ -153,6 +169,7 @@ getClosureDataFromHeapObject x = do (# infoTableAddr, heapRep, pointersArray #) -> do let infoTablePtr = Ptr infoTableAddr ptrList = [case indexArray# pointersArray i of +-- TODO: What happens if the GC kicks in here? Is that possible? check Cmm. (# ptr #) -> Box ptr | I# i <- [0..I# (sizeofArray# pointersArray) - 1] ] @@ -163,223 +180,35 @@ getClosureDataFromHeapObject x = do STACK -> pure $ UnsupportedClosure infoTable _ -> getClosureDataFromHeapRep heapRep infoTablePtr ptrList +-- | Like 'getClosureData', but taking a 'Box', so it is easier to work with. +getBoxedClosureData :: Box -> IO Closure +getBoxedClosureData (Box a) = getClosureData a --- | Convert an unpacked heap object, to a `GenClosure b`. The inputs to this --- function can be generated from a heap object using `unpackClosure#`. -getClosureDataFromHeapRep :: ByteArray# -> Ptr StgInfoTable -> [b] -> IO (GenClosure b) -getClosureDataFromHeapRep heapRep infoTablePtr pts = do - itbl <- peekItbl infoTablePtr - getClosureDataFromHeapRepPrim (dataConNames infoTablePtr) PPI.peekTopCCS itbl heapRep pts - -getClosureDataFromHeapRepPrim - :: IO (String, String, String) - -- ^ A continuation used to decode the constructor description field, - -- in ghc-debug this code can lead to segfaults because dataConNames - -- will dereference a random part of memory. - -> (Ptr a -> IO (Maybe CostCentreStack)) - -- ^ A continuation which is used to decode a cost centre stack - -- In ghc-debug, this code will need to call back into the debuggee to - -- fetch the representation of the CCS before decoding it. Using - -- `peekTopCCS` for this argument can lead to segfaults in ghc-debug as - -- the CCS argument will point outside the copied closure. - -> StgInfoTable - -- ^ The `StgInfoTable` of the closure, extracted from the heap - -- representation. - -> ByteArray# - -- ^ Heap representation of the closure as returned by `unpackClosure#`. - -- This includes all of the object including the header, info table - -- pointer, pointer data, and non-pointer data. The ByteArray# may be - -- pinned or unpinned. - -> [b] - -- ^ Pointers in the payload of the closure, extracted from the heap - -- representation as returned by `collect_pointers()` in `Heap.c`. The type - -- `b` is some representation of a pointer e.g. `Any` or `Ptr Any`. - -> IO (GenClosure b) - -- ^ Heap representation of the closure. -getClosureDataFromHeapRepPrim getConDesc decodeCCS itbl heapRep pts = do - let -- heapRep as a list of words. - rawHeapWords :: [Word] - rawHeapWords = [W# (indexWordArray# heapRep i) | I# i <- [0.. end] ] - where - nelems = I# (sizeofByteArray# heapRep) `div` wORD_SIZE - end = fromIntegral nelems - 1 - - -- Just the payload of rawHeapWords (no header). - payloadWords :: [Word] - payloadWords = drop (closureTypeHeaderSize (tipe itbl)) rawHeapWords - - -- The non-pointer words in the payload. Only valid for closures with a - -- "pointers first" layout. Not valid for bit field layout. - npts :: [Word] - npts = drop (closureTypeHeaderSize (tipe itbl) + length pts) rawHeapWords - case tipe itbl of - t | t >= CONSTR && t <= CONSTR_NOCAF -> do - (p, m, n) <- getConDesc - pure $ ConstrClosure itbl pts npts p m n - - t | t >= THUNK && t <= THUNK_STATIC -> do - pure $ ThunkClosure itbl pts npts - - THUNK_SELECTOR -> case pts of - [] -> fail "Expected at least 1 ptr argument to THUNK_SELECTOR" - hd : _ -> pure $ SelectorClosure itbl hd - - t | t >= FUN && t <= FUN_STATIC -> do - pure $ FunClosure itbl pts npts - - AP -> case pts of - [] -> fail "Expected at least 1 ptr argument to AP" - hd : tl -> case payloadWords of - -- We expect at least the arity, n_args, and fun fields - splitWord : _ : _ -> - pure $ APClosure itbl -#if defined(WORDS_BIGENDIAN) - (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2)) - (fromIntegral splitWord) -#else - (fromIntegral splitWord) - (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2)) -#endif - hd tl - _ -> fail "Expected at least 2 raw words to AP" - - PAP -> case pts of - [] -> fail "Expected at least 1 ptr argument to PAP" - hd : tl -> case payloadWords of - -- We expect at least the arity, n_args, and fun fields - splitWord : _ : _ -> - pure $ PAPClosure itbl -#if defined(WORDS_BIGENDIAN) - (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2)) - (fromIntegral splitWord) -#else - (fromIntegral splitWord) - (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2)) -#endif - hd tl - _ -> fail "Expected at least 2 raw words to PAP" - - AP_STACK -> case pts of - [] -> fail "Expected at least 1 ptr argument to AP_STACK" - hd : tl -> pure $ APStackClosure itbl hd tl - - IND -> case pts of - [] -> fail "Expected at least 1 ptr argument to IND" - hd : _ -> pure $ IndClosure itbl hd - - IND_STATIC -> case pts of - [] -> fail "Expected at least 1 ptr argument to IND_STATIC" - hd : _ -> pure $ IndClosure itbl hd - - BLACKHOLE -> case pts of - [] -> fail "Expected at least 1 ptr argument to BLACKHOLE" - hd : _ -> pure $ BlackholeClosure itbl hd - - BCO -> case pts of - pts0 : pts1 : pts2 : _ -> case payloadWords of - _ : _ : _ : splitWord : payloadRest -> - pure $ BCOClosure itbl pts0 pts1 pts2 -#if defined(WORDS_BIGENDIAN) - (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2)) - (fromIntegral splitWord) -#else - (fromIntegral splitWord) - (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2)) +#if MIN_TOOL_VERSION_ghc(9,5,0) +getBoxedClosureData b@(StackFrameBox sfi) = trace ("unpack " ++ show b) $ unpackStackFrameIter sfi #endif - payloadRest - _ -> fail $ "Expected at least 4 words to BCO, found " - ++ show (length payloadWords) - _ -> fail $ "Expected at least 3 ptr argument to BCO, found " - ++ show (length pts) - - ARR_WORDS -> case payloadWords of - [] -> fail $ "Expected at least 1 words to ARR_WORDS, found " - ++ show (length payloadWords) - hd : tl -> pure $ ArrWordsClosure itbl hd tl - - t | t >= MUT_ARR_PTRS_CLEAN && t <= MUT_ARR_PTRS_FROZEN_CLEAN -> case payloadWords of - p0 : p1 : _ -> pure $ MutArrClosure itbl p0 p1 pts - _ -> fail $ "Expected at least 2 words to MUT_ARR_PTRS_* " - ++ "found " ++ show (length payloadWords) - - t | t >= SMALL_MUT_ARR_PTRS_CLEAN && t <= SMALL_MUT_ARR_PTRS_FROZEN_CLEAN -> case payloadWords of - [] -> fail $ "Expected at least 1 word to SMALL_MUT_ARR_PTRS_* " - ++ "found " ++ show (length payloadWords) - hd : _ -> pure $ SmallMutArrClosure itbl hd pts - t | t == MUT_VAR_CLEAN || t == MUT_VAR_DIRTY -> case pts of - [] -> fail $ "Expected at least 1 words to MUT_VAR, found " - ++ show (length pts) - hd : _ -> pure $ MutVarClosure itbl hd - - t | t == MVAR_CLEAN || t == MVAR_DIRTY -> case pts of - pts0 : pts1 : pts2 : _ -> pure $ MVarClosure itbl pts0 pts1 pts2 - _ -> fail $ "Expected at least 3 ptrs to MVAR, found " - ++ show (length pts) - - BLOCKING_QUEUE -> - pure $ OtherClosure itbl pts rawHeapWords - - WEAK -> case pts of - pts0 : pts1 : pts2 : pts3 : rest -> pure $ WeakClosure - { info = itbl - , cfinalizers = pts0 - , key = pts1 - , value = pts2 - , finalizer = pts3 - , weakLink = case rest of - [] -> Nothing - [p] -> Just p - _ -> error $ "Expected 4 or 5 words in WEAK, but found more: " ++ show (length pts) - } - _ -> error $ "Expected 4 or 5 words in WEAK, but found less: " ++ show (length pts) - TSO | ( u_lnk : u_gbl_lnk : tso_stack : u_trec : u_blk_ex : u_bq : other) <- pts - -> withArray rawHeapWords (\ptr -> do - fields <- FFIClosures.peekTSOFields decodeCCS ptr - pure $ TSOClosure - { info = itbl - , link = u_lnk - , global_link = u_gbl_lnk - , tsoStack = tso_stack - , trec = u_trec - , blocked_exceptions = u_blk_ex - , bq = u_bq - , thread_label = case other of - [tl] -> Just tl - [] -> Nothing - _ -> error $ "thead_label:Expected 0 or 1 extra arguments" - , what_next = FFIClosures.tso_what_next fields - , why_blocked = FFIClosures.tso_why_blocked fields - , flags = FFIClosures.tso_flags fields - , threadId = FFIClosures.tso_threadId fields - , saved_errno = FFIClosures.tso_saved_errno fields - , tso_dirty = FFIClosures.tso_dirty fields - , alloc_limit = FFIClosures.tso_alloc_limit fields - , tot_stack_size = FFIClosures.tso_tot_stack_size fields - , prof = FFIClosures.tso_prof fields - }) - | otherwise - -> fail $ "Expected at least 6 ptr arguments to TSO, found " - ++ show (length pts) - STACK - | [] <- pts - -> withArray rawHeapWords (\ptr -> do - fields <- FFIClosures.peekStackFields ptr - pure $ StackClosure - { info = itbl - , stack_size = FFIClosures.stack_size fields - , stack_dirty = FFIClosures.stack_dirty fields -#if __GLASGOW_HASKELL__ >= 811 - , stack_marking = FFIClosures.stack_marking fields +-- | Get the size of the top-level closure in words. +-- Includes header and payload. Does not follow pointers. +-- +-- @since 8.10.1 +closureSize :: Box -> IO Int +closureSize (Box x) = pure $ I# (closureSize# x) +#if MIN_VERSION_base(4,17,0) +closureSize (StackFrameBox sfi) = unpackStackFrameIter sfi <&> + \c -> + case c of + UpdateFrame {} -> sizeStgUpdateFrame + CatchFrame {} -> sizeStgCatchFrame + CatchStmFrame {} -> sizeStgCatchSTMFrame + CatchRetryFrame {} -> sizeStgCatchRetryFrame + AtomicallyFrame {} -> sizeStgAtomicallyFrame + RetSmall {..} -> sizeStgClosure + length payload + RetBig {..} -> sizeStgClosure + length payload + RetFun {..} -> sizeStgRetFunFrame + length retFunPayload + -- The one additional word is a pointer to the StgBCO in the closure's payload + RetBCO {..} -> sizeStgClosure + 1 + length bcoArgs + -- The one additional word is a pointer to the next stack chunk + UnderflowFrame {} -> sizeStgClosure + 1 + _ -> error "Unexpected closure type" #endif - }) - | otherwise - -> fail $ "Expected 0 ptr argument to STACK, found " - ++ show (length pts) - - _ -> - pure $ UnsupportedClosure itbl - --- | Like 'getClosureData', but taking a 'Box', so it is easier to work with. -getBoxedClosureData :: Box -> IO Closure -getBoxedClosureData (Box a) = getClosureData a ===================================== libraries/ghc-heap/GHC/Exts/Heap/Closures.hs ===================================== @@ -15,13 +15,19 @@ module GHC.Exts.Heap.Closures ( , WhatNext(..) , WhyBlocked(..) , TsoFlags(..) + , UpdateFrameType(..) + , SpecialRetSmall(..) + , RetFunType(..) , allClosures - , closureSize -- * Boxes , Box(..) , areBoxesEqual , asBox +#if MIN_VERSION_base(4,17,0) + , SfiKind(..) + , StackFrameIter(..) +#endif ) where import Prelude -- See note [Why do we import Prelude here?] @@ -48,6 +54,13 @@ import GHC.Exts import GHC.Generics import Numeric +#if MIN_VERSION_base(4,17,0) +import GHC.Stack.CloneStack (StackSnapshot(..)) +import GHC.Exts.StackConstants +import Unsafe.Coerce (unsafeCoerce) +import Data.Functor +#endif + ------------------------------------------------------------------------ -- Boxes @@ -56,12 +69,47 @@ foreign import prim "aToWordzh" aToWord# :: Any -> Word# foreign import prim "reallyUnsafePtrEqualityUpToTag" reallyUnsafePtrEqualityUpToTag# :: Any -> Any -> Int# +#if MIN_VERSION_base(4,17,0) +foreign import prim "stackSnapshotToWordzh" stackSnapshotToWord# :: StackSnapshot# -> Word# + +foreign import prim "eqStackSnapshotszh" eqStackSnapshots# :: StackSnapshot# -> StackSnapshot# -> Word# +#endif -- | An arbitrary Haskell value in a safe Box. The point is that even -- unevaluated thunks can safely be moved around inside the Box, and when -- required, e.g. in 'getBoxedClosureData', the function knows how far it has -- to evaluate the argument. +#if MIN_VERSION_base(4,17,0) +data SfiKind = SfiClosure | SfiPrimitive | SfiStack + deriving (Eq, Show) + +data StackFrameIter = StackFrameIter + { stackSnapshot# :: !StackSnapshot#, + index :: !WordOffset, + sfiKind :: !SfiKind + } + +instance Show StackFrameIter where + showsPrec _ (StackFrameIter s# i p) rs = + -- TODO: Record syntax could be nicer to read + "StackFrameIter(" ++ pad_out (showHex addr "") ++ ", " ++ show i ++ ", " ++ show p ++ ")" ++ rs + where + addr = W# (stackSnapshotToWord# s#) + pad_out ls = '0':'x':ls + +instance Show StackSnapshot where + showsPrec _ (StackSnapshot s#) rs = + -- TODO: Record syntax could be nicer to read + "StackSnapshot(" ++ pad_out (showHex addr "") ++ ")" ++ rs + where + addr = W# (stackSnapshotToWord# s#) + pad_out ls = '0':'x':ls + +data Box = Box Any | StackFrameBox StackFrameIter +#else data Box = Box Any +#endif +-- TODO: Handle PrimitiveWordHolder instance Show Box where -- From libraries/base/GHC/Ptr.lhs showsPrec _ (Box a) rs = @@ -72,6 +120,29 @@ instance Show Box where tag = ptr .&. fromIntegral tAG_MASK -- ((1 `shiftL` TAG_BITS) -1) addr = ptr - tag pad_out ls = '0':'x':ls +#if MIN_VERSION_base(4,17,0) + showsPrec _ (StackFrameBox sfi) rs = + -- TODO: Record syntax could be nicer to read + "(StackFrameBox StackFrameIter(" ++ show sfi ++ ")" ++ rs +#endif + +-- | Boxes can be compared, but this is not pure, as different heap objects can, +-- after garbage collection, become the same object. +-- TODO: Handle PrimitiveWordHolder +areBoxesEqual :: Box -> Box -> IO Bool +areBoxesEqual (Box a) (Box b) = case reallyUnsafePtrEqualityUpToTag# a b of + 0# -> pure False + _ -> pure True +#if MIN_VERSION_base(4,17,0) +-- TODO: Could be used for `instance Eq StackFrameIter` +areBoxesEqual + (StackFrameBox (StackFrameIter s1# i1 p1)) + (StackFrameBox (StackFrameIter s2# i2 p2)) = pure $ + W# (eqStackSnapshots# s1# s2#) == 1 + && i1 == i2 + && p1 == p2 +areBoxesEqual _ _ = pure False +#endif -- |This takes an arbitrary value and puts it into a box. -- Note that calls like @@ -85,14 +156,6 @@ instance Show Box where asBox :: a -> Box asBox x = Box (unsafeCoerce# x) --- | Boxes can be compared, but this is not pure, as different heap objects can, --- after garbage collection, become the same object. -areBoxesEqual :: Box -> Box -> IO Bool -areBoxesEqual (Box a) (Box b) = case reallyUnsafePtrEqualityUpToTag# a b of - 0# -> pure False - _ -> pure True - - ------------------------------------------------------------------------ -- Closures @@ -301,8 +364,78 @@ data GenClosure b #if __GLASGOW_HASKELL__ >= 811 , stack_marking :: !Word8 #endif + -- | The frames of the stack. Only available if a cloned stack was + -- decoded, otherwise empty. + , stack :: ![b] + } + +#if MIN_TOOL_VERSION_ghc(9,5,0) + | UpdateFrame + { info :: !StgInfoTable + , knownUpdateFrameType :: !UpdateFrameType + , updatee :: !b } + | CatchFrame + { info :: !StgInfoTable + , exceptions_blocked :: Word + , handler :: !b + } + + | CatchStmFrame + { info :: !StgInfoTable + , catchFrameCode :: !b + , handler :: !b + } + + | CatchRetryFrame + { info :: !StgInfoTable + , running_alt_code :: !Word + , first_code :: !b + , alt_code :: !b + } + + | AtomicallyFrame + { info :: !StgInfoTable + , atomicallyFrameCode :: !b + , result :: !b + } + + -- TODO: nextChunk could be a CL.Closure, too! (StackClosure) + | UnderflowFrame + { info :: !StgInfoTable + , nextChunk :: !b + } + + | StopFrame + { info :: !StgInfoTable } + + | RetSmall + { info :: !StgInfoTable + , knownRetSmallType :: !SpecialRetSmall + , payload :: ![b] + } + + | RetBig + { info :: !StgInfoTable + , payload :: ![b] + } + + | RetFun + { info :: !StgInfoTable + , retFunType :: RetFunType + , retFunSize :: Word + , retFunFun :: !b + , retFunPayload :: ![b] + } + + | RetBCO + -- TODO: Add pre-defined BCO closures (like knownUpdateFrameType) + { info :: !StgInfoTable + , bco :: !b -- must be a BCOClosure + , bcoArgs :: ![b] + } +#endif ------------------------------------------------------------ -- Unboxed unlifted closures @@ -354,8 +487,73 @@ data GenClosure b | UnsupportedClosure { info :: !StgInfoTable } - deriving (Show, Generic, Functor, Foldable, Traversable) + | UnknownTypeWordSizedPrimitive + { wordVal :: !Word } + deriving (Eq, Show, Generic, Functor, Foldable, Traversable) + +-- TODO There are likely more. See MiscClosures.h +data SpecialRetSmall = + -- TODO: Shoudn't `None` be better `Maybe ...`? + None | + ApV | + ApF | + ApD | + ApL | + ApN | + ApP | + ApPP | + ApPPP | + ApPPPP | + ApPPPPP | + ApPPPPPP | + RetV | + RetP | + RetN | + RetF | + RetD | + RetL | + RestoreCCCS | + RestoreCCCSEval + deriving (Enum, Eq, Show, Generic) + +data UpdateFrameType = + NormalUpdateFrame | + BhUpdateFrame | + MarkedUpdateFrame + deriving (Enum, Eq, Show, Generic, Ord) + +data RetFunType = + ARG_GEN | + ARG_GEN_BIG | + ARG_BCO | + ARG_NONE | + ARG_N | + ARG_P | + ARG_F | + ARG_D | + ARG_L | + ARG_V16 | + ARG_V32 | + ARG_V64 | + ARG_NN | + ARG_NP | + ARG_PN | + ARG_PP | + ARG_NNN | + ARG_NNP | + ARG_NPN | + ARG_NPP | + ARG_PNN | + ARG_PNP | + ARG_PPN | + ARG_PPP | + ARG_PPPP | + ARG_PPPPP | + ARG_PPPPPP | + ARG_PPPPPPP | + ARG_PPPPPPPP + deriving (Show, Eq, Enum, Generic) data PrimType = PInt @@ -424,11 +622,17 @@ allClosures (FunClosure {..}) = ptrArgs allClosures (BlockingQueueClosure {..}) = [link, blackHole, owner, queue] allClosures (WeakClosure {..}) = [cfinalizers, key, value, finalizer] ++ Data.Foldable.toList weakLink allClosures (OtherClosure {..}) = hvalues +#if MIN_TOOL_VERSION_ghc(9,5,0) +allClosures (StackClosure {..}) = stack +allClosures (UpdateFrame {..}) = [updatee] +allClosures (CatchFrame {..}) = [handler] +allClosures (CatchStmFrame {..}) = [catchFrameCode, handler] +allClosures (CatchRetryFrame {..}) = [first_code, alt_code] +allClosures (AtomicallyFrame {..}) = [atomicallyFrameCode, result] +allClosures (RetSmall {..}) = payload +allClosures (RetBig {..}) = payload +allClosures (RetFun {..}) = retFunFun : retFunPayload +allClosures (RetBCO {..}) = bco : bcoArgs +#endif allClosures _ = [] --- | Get the size of the top-level closure in words. --- Includes header and payload. Does not follow pointers. --- --- @since 8.10.1 -closureSize :: Box -> Int -closureSize (Box x) = I# (closureSize# x) ===================================== libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} +{-# LANGUAGE BangPatterns #-} module GHC.Exts.Heap.FFIClosures_ProfilingDisabled where @@ -14,6 +15,7 @@ import GHC.Exts import GHC.Exts.Heap.ProfInfo.PeekProfInfo import GHC.Exts.Heap.ProfInfo.Types import GHC.Exts.Heap.Closures(WhatNext(..), WhyBlocked(..), TsoFlags(..)) +import Numeric data TSOFields = TSOFields { tso_what_next :: WhatNext, @@ -102,10 +104,11 @@ data StackFields = StackFields { #if __GLASGOW_HASKELL__ >= 811 stack_marking :: Word8, #endif - stack_sp :: Addr## + stack_sp :: Addr##, + stack_stack :: Addr## } --- | Get non-closure fields from @StgStack_@ (@TSO.h@) +-- | Get fields from @StgStack_@ (@TSO.h@) peekStackFields :: Ptr a -> IO StackFields peekStackFields ptr = do stack_size' <- (#peek struct StgStack_, stack_size) ptr ::IO Word32 @@ -114,8 +117,7 @@ peekStackFields ptr = do marking' <- (#peek struct StgStack_, marking) ptr #endif Ptr sp' <- (#peek struct StgStack_, sp) ptr - - -- TODO decode the stack. + let !(Ptr stack') = (#ptr struct StgStack_, stack) ptr return StackFields { stack_size = stack_size', @@ -123,6 +125,9 @@ peekStackFields ptr = do #if __GLASGOW_HASKELL__ >= 811 stack_marking = marking', #endif - stack_sp = sp' + stack_sp = sp', + stack_stack = stack' } +showAddr## :: Addr## -> String +showAddr## addr## = (showHex $ I## (addr2Int## addr##)) "" ===================================== libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc ===================================== @@ -37,4 +37,4 @@ data StgInfoTable = StgInfoTable { tipe :: ClosureType, srtlen :: HalfWord, code :: Maybe ItblCodes -- Just <=> TABLES_NEXT_TO_CODE - } deriving (Show, Generic) + } deriving (Eq, Show, Generic) ===================================== libraries/ghc-heap/GHC/Exts/StackConstants.hsc ===================================== @@ -0,0 +1,115 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module GHC.Exts.StackConstants where + +-- TODO: Better expression to allow is only for the latest (this branch) GHC? +#if MIN_TOOL_VERSION_ghc(9,5,0) + +import Prelude + +#include "Rts.h" +#undef BLOCK_SIZE +#undef MBLOCK_SIZE +#undef BLOCKS_PER_MBLOCK +#include "DerivedConstants.h" + +newtype ByteOffset = ByteOffset { offsetInBytes :: Int } + deriving newtype (Eq, Show, Integral, Real, Num, Enum, Ord) + +newtype WordOffset = WordOffset { offsetInWords :: Int } + deriving newtype (Eq, Show, Integral, Real, Num, Enum, Ord) + +offsetStgCatchFrameHandler :: WordOffset +offsetStgCatchFrameHandler = byteOffsetToWordOffset $ (#const OFFSET_StgCatchFrame_handler) + (#size StgHeader) + +offsetStgCatchFrameExceptionsBlocked :: WordOffset +offsetStgCatchFrameExceptionsBlocked = byteOffsetToWordOffset $ (#const OFFSET_StgCatchFrame_exceptions_blocked) + (#size StgHeader) + +sizeStgCatchFrame :: Int +sizeStgCatchFrame = bytesToWords $ (#const SIZEOF_StgCatchFrame_NoHdr) + (#size StgHeader) + +offsetStgCatchSTMFrameCode :: WordOffset +offsetStgCatchSTMFrameCode = byteOffsetToWordOffset $ (#const OFFSET_StgCatchSTMFrame_code) + (#size StgHeader) + +offsetStgCatchSTMFrameHandler :: WordOffset +offsetStgCatchSTMFrameHandler = byteOffsetToWordOffset $ (#const OFFSET_StgCatchSTMFrame_handler) + (#size StgHeader) + +sizeStgCatchSTMFrame :: Int +sizeStgCatchSTMFrame = bytesToWords $ (#const SIZEOF_StgCatchSTMFrame_NoHdr) + (#size StgHeader) + +offsetStgUpdateFrameUpdatee :: WordOffset +offsetStgUpdateFrameUpdatee = byteOffsetToWordOffset $ (#const OFFSET_StgUpdateFrame_updatee) + (#size StgHeader) + +sizeStgUpdateFrame :: Int +sizeStgUpdateFrame = bytesToWords $ (#const SIZEOF_StgUpdateFrame_NoHdr) + (#size StgHeader) + +offsetStgAtomicallyFrameCode :: WordOffset +offsetStgAtomicallyFrameCode = byteOffsetToWordOffset $ (#const OFFSET_StgAtomicallyFrame_code) + (#size StgHeader) + +offsetStgAtomicallyFrameResult :: WordOffset +offsetStgAtomicallyFrameResult = byteOffsetToWordOffset $ (#const OFFSET_StgAtomicallyFrame_result) + (#size StgHeader) + +sizeStgAtomicallyFrame :: Int +sizeStgAtomicallyFrame = bytesToWords $ (#const SIZEOF_StgAtomicallyFrame_NoHdr) + (#size StgHeader) + +offsetStgCatchRetryFrameRunningAltCode :: WordOffset +offsetStgCatchRetryFrameRunningAltCode = byteOffsetToWordOffset $ (#const OFFSET_StgCatchRetryFrame_running_alt_code) + (#size StgHeader) + +offsetStgCatchRetryFrameRunningFirstCode :: WordOffset +offsetStgCatchRetryFrameRunningFirstCode = byteOffsetToWordOffset $ (#const OFFSET_StgCatchRetryFrame_first_code) + (#size StgHeader) + +offsetStgCatchRetryFrameAltCode :: WordOffset +offsetStgCatchRetryFrameAltCode = byteOffsetToWordOffset $ (#const OFFSET_StgCatchRetryFrame_alt_code) + (#size StgHeader) + +sizeStgCatchRetryFrame :: Int +sizeStgCatchRetryFrame = bytesToWords $ (#const SIZEOF_StgCatchRetryFrame_NoHdr) + (#size StgHeader) + +offsetStgRetFunFrameSize :: WordOffset +-- StgRetFun has no header, but only a pointer to the info table at the beginning. +offsetStgRetFunFrameSize = byteOffsetToWordOffset $ (#const OFFSET_StgRetFun_size) + +offsetStgRetFunFrameFun :: WordOffset +offsetStgRetFunFrameFun = byteOffsetToWordOffset $ (#const OFFSET_StgRetFun_fun) + +offsetStgRetFunFramePayload :: WordOffset +offsetStgRetFunFramePayload = byteOffsetToWordOffset $ (#const OFFSET_StgRetFun_payload) + +sizeStgRetFunFrame :: Int +sizeStgRetFunFrame = bytesToWords (#const SIZEOF_StgRetFun) + +offsetStgBCOFrameInstrs :: ByteOffset +offsetStgBCOFrameInstrs = (#const OFFSET_StgBCO_instrs) + (#size StgHeader) + +offsetStgBCOFrameLiterals :: ByteOffset +offsetStgBCOFrameLiterals = (#const OFFSET_StgBCO_literals) + (#size StgHeader) + +offsetStgBCOFramePtrs :: ByteOffset +offsetStgBCOFramePtrs = (#const OFFSET_StgBCO_ptrs) + (#size StgHeader) + +offsetStgBCOFrameArity :: ByteOffset +offsetStgBCOFrameArity = (#const OFFSET_StgBCO_arity) + (#size StgHeader) + +offsetStgBCOFrameSize :: ByteOffset +offsetStgBCOFrameSize = (#const OFFSET_StgBCO_size) + (#size StgHeader) + +offsetStgClosurePayload :: WordOffset +offsetStgClosurePayload = byteOffsetToWordOffset $ (#const OFFSET_StgClosure_payload) + (#size StgHeader) + +sizeStgClosure :: Int +sizeStgClosure = bytesToWords (#size StgHeader) + +byteOffsetToWordOffset :: ByteOffset -> WordOffset +byteOffsetToWordOffset = WordOffset . bytesToWords . fromInteger . toInteger + +bytesToWords :: Int -> Int +bytesToWords b = + if b `mod` bytesInWord == 0 then + fromIntegral $ b `div` bytesInWord + else + error "Unexpected struct alignment!" + +bytesInWord :: Int +bytesInWord = (#const SIZEOF_VOID_P) + +#endif ===================================== libraries/ghc-heap/cbits/Stack.c ===================================== @@ -0,0 +1,253 @@ +#include "MachDeps.h" +#include "Rts.h" +#include "RtsAPI.h" +#include "rts/Messages.h" +#include "rts/Types.h" +#include "rts/storage/ClosureTypes.h" +#include "rts/storage/Closures.h" +#include "rts/storage/InfoTables.h" + +StgWord stackFrameSize(StgStack *stack, StgWord index) { + StgClosure *c = (StgClosure *)stack->sp + index; + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + return stack_frame_sizeW(c); +} + +StgStack *getUnderflowFrameStack(StgStack *stack, StgWord index) { + StgClosure *frame = (StgClosure *)stack->sp + index; + ASSERT(LOOKS_LIKE_CLOSURE_PTR(frame)); + const StgRetInfoTable *info = get_ret_itbl((StgClosure *)frame); + + if (info->i.type == UNDERFLOW_FRAME) { + return ((StgUnderflowFrame *)frame)->next_chunk; + } else { + return NULL; + } +} + +// Only exists to make the get_itbl macro available in Haskell code (via FFI). +const StgInfoTable *getItbl(StgClosure *closure) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(closure)); + // printObj(closure); + return get_itbl(closure); +}; + +StgWord getSpecialRetSmall(StgClosure *closure) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(closure)); + StgWord c = *(StgWord *)closure; + if (c == (StgWord)&stg_ap_v_info) { + return 1; + } else if (c == (StgWord)&stg_ap_f_info) { + return 2; + } else if (c == (StgWord)&stg_ap_d_info) { + return 3; + } else if (c == (StgWord)&stg_ap_l_info) { + return 4; + } else if (c == (StgWord)&stg_ap_n_info) { + return 5; + } else if (c == (StgWord)&stg_ap_p_info) { + return 6; + } else if (c == (StgWord)&stg_ap_pp_info) { + return 7; + } else if (c == (StgWord)&stg_ap_ppp_info) { + return 8; + } else if (c == (StgWord)&stg_ap_pppp_info) { + return 9; + } else if (c == (StgWord)&stg_ap_ppppp_info) { + return 10; + } else if (c == (StgWord)&stg_ap_pppppp_info) { + return 11; + } else if (c == (StgWord)&stg_ret_v_info) { + return 12; + } else if (c == (StgWord)&stg_ret_p_info) { + return 13; + } else if (c == (StgWord)&stg_ret_n_info) { + return 14; + } else if (c == (StgWord)&stg_ret_f_info) { + return 15; + } else if (c == (StgWord)&stg_ret_d_info) { + return 16; + } else if (c == (StgWord)&stg_ret_l_info) { + return 17; +#if defined(PROFILING) + } else if (c == (StgWord)&stg_restore_cccs_info) { + return 18; + } else if (c == (StgWord)&stg_restore_cccs_eval_info) { + return 19; +#endif + } else { + return 0; + } +} + +StgWord getUpdateFrameType(StgClosure *c) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + + const StgInfoTable *info = c->header.info; + if (info == &stg_upd_frame_info) { + return 0; + } else if (info == &stg_bh_upd_frame_info) { + return 1; + } else if (info == &stg_marked_upd_frame_info) { + return 2; + } else { + // Cannot do more than warn and exit. + errorBelch("Cannot decide Update Frame type for info table %p closure %p.", + info, c); + stg_exit(EXIT_INTERNAL_ERROR); + } +} + +StgWord getBitmapSize(StgClosure *c) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + + const StgInfoTable *info = get_itbl(c); + StgWord bitmap = info->layout.bitmap; + return BITMAP_SIZE(bitmap); +} + +StgWord getRetFunBitmapSize(StgRetFun *ret_fun) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(ret_fun)); + + const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun)); + switch (fun_info->f.fun_type) { + case ARG_GEN: + return BITMAP_SIZE(fun_info->f.b.bitmap); + case ARG_GEN_BIG: + return GET_FUN_LARGE_BITMAP(fun_info)->size; + default: + return BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]); + } +} + +StgWord getBitmapWord(StgClosure *c) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + + const StgInfoTable *info = get_itbl(c); + StgWord bitmap = info->layout.bitmap; + StgWord bitmapWord = BITMAP_BITS(bitmap); + return bitmapWord; +} + +StgWord getRetFunBitmapWord(StgRetFun *ret_fun) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(ret_fun)); + + const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun)); + fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun)); + switch (fun_info->f.fun_type) { + case ARG_GEN: + return BITMAP_BITS(fun_info->f.b.bitmap); + case ARG_GEN_BIG: + // Cannot do more than warn and exit. + errorBelch("Unexpected ARG_GEN_BIG StgRetFun closure %p", ret_fun); + stg_exit(EXIT_INTERNAL_ERROR); + default: + return BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]); + } +} + +StgWord getLargeBitmapSize(StgClosure *c) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + + const StgInfoTable *info = get_itbl(c); + StgLargeBitmap *bitmap = GET_LARGE_BITMAP(info); + return bitmap->size; +} + +StgWord getRetFunSize(StgRetFun *ret_fun) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(ret_fun)); + + const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun)); + fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun)); + switch (fun_info->f.fun_type) { + case ARG_GEN: + return BITMAP_SIZE(fun_info->f.b.bitmap); + case ARG_GEN_BIG: + return GET_FUN_LARGE_BITMAP(fun_info)->size; + default: + return BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]); + } +} + +StgWord getBCOLargeBitmapSize(StgClosure *c) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + + StgBCO *bco = (StgBCO *)*c->payload; + + return BCO_BITMAP_SIZE(bco); +} + +#define ROUNDUP_BITS_TO_WDS(n) \ + (((n) + WORD_SIZE_IN_BITS - 1) / WORD_SIZE_IN_BITS) + +// Copied from Cmm.h +#define SIZEOF_W SIZEOF_VOID_P +#define WDS(n) ((n)*SIZEOF_W) + +static StgArrBytes *largeBitmapToStgArrBytes(Capability *cap, StgLargeBitmap *bitmap) { + StgWord neededWords = ROUNDUP_BITS_TO_WDS(bitmap->size); + StgArrBytes *array = + (StgArrBytes *)allocate(cap, sizeofW(StgArrBytes) + neededWords); + SET_HDR(array, &stg_ARR_WORDS_info, CCS_SYSTEM); + array->bytes = WDS(ROUNDUP_BITS_TO_WDS(bitmap->size)); + + for (int i = 0; i < neededWords; i++) { + array->payload[i] = bitmap->bitmap[i]; + } + + return array; +} + +StgArrBytes *getLargeBitmap(Capability *cap, StgClosure *c) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + debugBelch("getLargeBitmap %p \n", c); + const StgInfoTable *info = get_itbl(c); + debugBelch("getLargeBitmap tipe %ul \n", info->type); + StgLargeBitmap *bitmap = GET_LARGE_BITMAP(info); + debugBelch("getLargeBitmap size %lu \n", bitmap->size); + + return largeBitmapToStgArrBytes(cap, bitmap); +} + +StgArrBytes *getRetFunLargeBitmap(Capability *cap, StgRetFun *ret_fun) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(ret_fun)); + + const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun)); + StgLargeBitmap *bitmap = GET_FUN_LARGE_BITMAP(fun_info); + + return largeBitmapToStgArrBytes(cap, bitmap); +} + +StgArrBytes *getBCOLargeBitmap(Capability *cap, StgClosure *c) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + + StgBCO *bco = (StgBCO *)*c->payload; + StgLargeBitmap *bitmap = BCO_BITMAP(bco); + + return largeBitmapToStgArrBytes(cap, bitmap); +} + +#if defined(DEBUG) +extern void printStack(StgStack *stack); +void belchStack(StgStack *stack) { printStack(stack); } +#endif + +StgStack *getUnderflowFrameNextChunk(StgUnderflowFrame *frame) { + return frame->next_chunk; +} + +StgWord getRetFunType(StgRetFun *ret_fun) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(ret_fun)); + + const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun)); + return fun_info->f.fun_type; +} + +RTS_INFO(box_info); +StgClosure* getBoxedClosure(Capability *cap, StgClosure **c){ +// StgClosure *box = (StgClosure*) allocate(cap, sizeofW(StgClosure) + 1); +// SET_HDR(box, &box_info, CCS_SYSTEM); +// box->payload[0] = *c; +// return box; + return *c; +} ===================================== libraries/ghc-heap/cbits/Stack.cmm ===================================== @@ -0,0 +1,223 @@ +// Uncomment to enable assertions during development +// #define DEBUG 1 + +#include "Cmm.h" + +#if defined(StgStack_marking) +advanceStackFrameIterzh (P_ stack, W_ offsetWords) { + W_ frameSize; + (frameSize) = ccall stackFrameSize(stack, offsetWords); + + P_ nextClosurePtr; + nextClosurePtr = (StgStack_sp(stack) + WDS(offsetWords) + WDS(frameSize)); + + P_ stackArrayPtr; + stackArrayPtr = stack + SIZEOF_StgHeader + OFFSET_StgStack_stack; + + P_ stackBottom; + W_ stackSize, stackSizeInBytes; + stackSize = TO_W_(StgStack_stack_size(stack)); + stackSizeInBytes = WDS(stackSize); + stackBottom = stackSizeInBytes + stackArrayPtr; + + P_ newStack; + W_ newOffsetWords, hasNext; + if(nextClosurePtr < stackBottom) (likely: True) { + newStack = stack; + newOffsetWords = offsetWords + frameSize; + hasNext = 1; + } else { + P_ underflowFrameStack; + (underflowFrameStack) = ccall getUnderflowFrameStack(stack, offsetWords); + if (underflowFrameStack == NULL) (likely: True) { + newStack = NULL; + newOffsetWords = NULL; + hasNext = NULL; + } else { + newStack = underflowFrameStack; + newOffsetWords = NULL; + hasNext = 1; + } + } + + return (newStack, newOffsetWords, hasNext); +} + +derefStackWordzh (P_ stack, W_ offsetWords) { + P_ sp; + sp = StgStack_sp(stack); + + return (W_[sp + WDS(offsetWords)]); +} + +getSmallBitmapzh(P_ stack, W_ offsetWords) { + P_ c; + c = StgStack_sp(stack) + WDS(offsetWords); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + + W_ bitmap, size; + (bitmap) = ccall getBitmapWord(c); + (size) = ccall getBitmapSize(c); + + return (bitmap, size); +} + +getRetSmallSpecialTypezh(P_ stack, W_ offsetWords) { + P_ c; + c = StgStack_sp(stack) + WDS(offsetWords); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + + W_ specialType; + (specialType) = ccall getSpecialRetSmall(c); + + return (specialType); +} + +getRetFunSmallBitmapzh(P_ stack, W_ offsetWords) { + P_ c; + c = StgStack_sp(stack) + WDS(offsetWords); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + + W_ bitmap, size, specialType; + (bitmap) = ccall getRetFunBitmapWord(c); + (size) = ccall getRetFunBitmapSize(c); + + return (bitmap, size); +} + +getLargeBitmapzh(P_ stack, W_ offsetWords){ + P_ c, stgArrBytes; + W_ size; + c = StgStack_sp(stack) + WDS(offsetWords); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + + (stgArrBytes) = ccall getLargeBitmap(MyCapability(), c); + (size) = ccall getLargeBitmapSize(c); + + return (stgArrBytes, size); +} + +getBCOLargeBitmapzh(P_ stack, W_ offsetWords){ + P_ c, stgArrBytes; + W_ size; + c = StgStack_sp(stack) + WDS(offsetWords); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + + (stgArrBytes) = ccall getBCOLargeBitmap(MyCapability(), c); + (size) = ccall getBCOLargeBitmapSize(c); + + return (stgArrBytes, size); +} + +getRetFunLargeBitmapzh(P_ stack, W_ offsetWords){ + P_ c, stgArrBytes; + W_ size; + c = StgStack_sp(stack) + WDS(offsetWords); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + + (stgArrBytes) = ccall getRetFunLargeBitmap(MyCapability(), c); + (size) = ccall getRetFunSize(c); + + return (stgArrBytes, size); +} + +getUpdateFrameTypezh(P_ stack, W_ offsetWords){ + P_ c; + c = StgStack_sp(stack) + WDS(offsetWords); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + + W_ type; + (type) = ccall getUpdateFrameType(c); + return (type); +} + +getWordzh(P_ stack, W_ offsetWords, W_ offsetBytes){ + P_ wordAddr; + wordAddr = (StgStack_sp(stack) + WDS(offsetWords) + WDS(offsetBytes)); + return (W_[wordAddr]); +} + +getAddrzh(P_ stack, W_ offsetWords){ + P_ addr; + addr = (StgStack_sp(stack) + WDS(offsetWords)); + P_ ptr; + ptr = P_[addr]; +// ccall printObj(ptr); + return (ptr); +} + +getUnderflowFrameNextChunkzh(P_ stack, W_ offsetWords){ + P_ closurePtr; + closurePtr = (StgStack_sp(stack) + WDS(offsetWords)); + ASSERT(LOOKS_LIKE_CLOURE_PTR(closurePtr)); + + P_ next_chunk; + (next_chunk) = ccall getUnderflowFrameNextChunk(closurePtr); + ASSERT(LOOKS_LIKE_CLOURE_PTR(next_chunk)); + return (next_chunk); +} + +getRetFunTypezh(P_ stack, W_ offsetWords){ + P_ c; + c = StgStack_sp(stack) + WDS(offsetWords); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + + W_ type; + (type) = ccall getRetFunType(c); + return (type); +} + +getInfoTableAddrzh(P_ stack, W_ offsetWords){ + P_ p, info; + p = StgStack_sp(stack) + WDS(offsetWords); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); + info = %GET_STD_INFO(UNTAG(p)); + + return (info); +} + +getStackInfoTableAddrzh(P_ stack){ + P_ info; + info = %GET_STD_INFO(UNTAG(stack)); + return (info); +} + +// Just a cast +stackSnapshotToWordzh(P_ stack) { + return (stack); +} + +eqStackSnapshotszh(P_ stack1, P_ stack2) { + ccall checkSTACK(stack1); + ccall checkSTACK(stack2); + return (stack1 == stack2); +} + +getBoxedClosurezh(P_ stack, W_ offsetWords){ + ccall debugBelch("getBoxedClosurezh - stack %p , offsetWords %lu", stack, offsetWords); + + ccall checkSTACK(stack); + P_ ptr; + ptr = StgStack_sp(stack) + WDS(offsetWords); + + P_ box; + (box) = ccall getBoxedClosure(MyCapability(), ptr); + ccall debugBelch("getBoxedClosurezh - box %p", box); + return (box); +} + +// TODO: Unused? +INFO_TABLE_CONSTR(box, 1, 0, 0, CONSTR_1_0, "BOX", "BOX") +{ foreign "C" barf("BOX object (%p) entered!", R1) never returns; } + +getStackFieldszh(P_ stack){ + bits32 size; + bits8 dirty, marking; + + size = StgStack_stack_size(stack); + dirty = StgStack_dirty(stack); + marking = StgStack_marking(stack); + + return (size, dirty, marking); +} +#endif ===================================== libraries/ghc-heap/ghc-heap.cabal.in ===================================== @@ -30,6 +30,8 @@ library ghc-options: -Wall if !os(ghcjs) cmm-sources: cbits/HeapPrim.cmm + cbits/Stack.cmm + c-sources: cbits/Stack.c default-extensions: NoImplicitPrelude @@ -37,6 +39,8 @@ library GHC.Exts.Heap.Closures GHC.Exts.Heap.ClosureTypes GHC.Exts.Heap.Constants + GHC.Exts.DecodeHeap + GHC.Exts.DecodeStack GHC.Exts.Heap.InfoTable GHC.Exts.Heap.InfoTable.Types GHC.Exts.Heap.InfoTableProf @@ -48,3 +52,4 @@ library GHC.Exts.Heap.ProfInfo.PeekProfInfo GHC.Exts.Heap.ProfInfo.PeekProfInfo_ProfilingDisabled GHC.Exts.Heap.ProfInfo.PeekProfInfo_ProfilingEnabled + GHC.Exts.StackConstants ===================================== libraries/ghc-heap/tests/TestUtils.hs ===================================== @@ -1,7 +1,56 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MagicHash #-} -module TestUtils where +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE UnliftedFFITypes #-} -assertEqual :: (Show a, Eq a) => a -> a -> IO () +module TestUtils + ( assertEqual, + assertThat, + assertStackInvariants, + getDecodedStack, + unbox, + ) +where + +import Control.Monad.IO.Class +import Data.Array.Byte +import Data.Foldable +import Debug.Trace +import GHC.Exts +import GHC.Exts.DecodeStack +import GHC.Exts.Heap +import GHC.Exts.Heap.Closures +import GHC.Records +import GHC.Stack (HasCallStack) +import GHC.Stack.CloneStack +import Unsafe.Coerce (unsafeCoerce) + +getDecodedStack :: IO (StackSnapshot, [Closure]) +getDecodedStack = do + s@(StackSnapshot s#) <- cloneMyStack + stackClosure <- getClosureData s# + unboxedCs <- mapM getBoxedClosureData (stack stackClosure) + pure (s, unboxedCs) + +assertEqual :: (HasCallStack, Monad m, Show a, Eq a) => a -> a -> m () assertEqual a b | a /= b = error (show a ++ " /= " ++ show b) - | otherwise = return () + | otherwise = pure () + +assertThat :: (HasCallStack, Monad m) => String -> (a -> Bool) -> a -> m () +assertThat s f a = if f a then pure () else error s + +assertStackInvariants :: (HasCallStack, MonadIO m) => StackSnapshot -> [Closure] -> m () +assertStackInvariants stack decodedStack = do + assertThat + "Last frame is stop frame" + ( \case + StopFrame info -> tipe info == STOP_FRAME + _ -> False + ) + (last decodedStack) + +unbox :: Box -> IO Closure +unbox = getBoxedClosureData ===================================== libraries/ghc-heap/tests/all.T ===================================== @@ -39,20 +39,68 @@ test('closure_size_noopt', compile_and_run, ['']) test('tso_and_stack_closures', - [extra_files(['create_tso.c','create_tso.h','TestUtils.hs']), + [extra_files(['create_tso.c','create_tso.h','TestUtils.hs','stack_lib.c']), only_ways(['profthreaded']), ignore_stdout, ignore_stderr ], - multi_compile_and_run, ['tso_and_stack_closures', [('create_tso.c','')], '']) + multi_compile_and_run, ['tso_and_stack_closures', [('create_tso.c',''), ('stack_lib.c', '')], '']) test('parse_tso_flags', - [extra_files(['TestUtils.hs']), + [extra_files(['stack_lib.c', 'TestUtils.hs']), only_ways(['normal']), ignore_stdout, ignore_stderr ], - compile_and_run, ['']) + multi_compile_and_run, ['parse_tso_flags', [('stack_lib.c','')], '']) test('T21622', only_ways(['normal']), compile_and_run, ['']) + +# TODO: Remove debug flags +test('stack_big_ret', + [ + extra_files(['TestUtils.hs']), + ignore_stdout, + ignore_stderr + ], + compile_and_run, + ['-debug -optc-g -g']) + +# TODO: Remove debug flags +# Options: +# - `-kc512B -kb64B`: Make stack chunk size small to provoke underflow stack frames. +test('stack_underflow', + [ + extra_files(['TestUtils.hs']), + extra_run_opts('+RTS -kc512B -kb64B -RTS'), + ignore_stdout, + ignore_stderr + ], + compile_and_run, + ['-debug -optc-g -g']) + +# TODO: Remove debug flags +test('stack_stm_frames', + [ + extra_files(['TestUtils.hs']), + ignore_stdout, + ignore_stderr + ], + compile_and_run, + ['-debug -optc-g -g']) + +# TODO: Remove debug flags +test('stack_misc_closures', + [ + extra_files(['stack_misc_closures_c.c', 'stack_misc_closures_prim.cmm', 'TestUtils.hs']), + ignore_stdout, + ignore_stderr + ], + multi_compile_and_run, + ['stack_misc_closures', + [ ('stack_misc_closures_c.c', '') + ,('stack_misc_closures_prim.cmm', '') + ] + , '-debug -optc-g -optc-O0 -g -ddump-to-file -dlint -ddump-cmm' # -with-rtsopts="-Dg -Ds -Db"' + ]) ===================================== libraries/ghc-heap/tests/stack_big_ret.hs ===================================== @@ -0,0 +1,140 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnliftedFFITypes #-} + +module Main where + +import Control.Concurrent +import Data.IORef +import Data.Maybe +import GHC.Exts (StackSnapshot#) +import GHC.Exts.DecodeStack +import GHC.Exts.Heap.ClosureTypes +import GHC.Exts.Heap.Closures +import GHC.Exts.Heap.InfoTable.Types +import GHC.IO.Unsafe +import GHC.Stack (HasCallStack) +import GHC.Stack.CloneStack +import System.IO (hPutStrLn, stderr) +import System.Mem +import TestUtils +import GHC.Exts.Heap + +cloneStackReturnInt :: IORef (Maybe StackSnapshot) -> Int +cloneStackReturnInt ioRef = unsafePerformIO $ do + stackSnapshot <- cloneMyStack + + writeIORef ioRef (Just stackSnapshot) + + pure 42 + +-- | Clone a stack with a RET_BIG closure and decode it. +main :: HasCallStack => IO () +main = do + stackRef <- newIORef Nothing + + bigFun (cloneStackReturnInt stackRef) 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 + + mbStackSnapshot <- readIORef stackRef + let stackSnapshot@(StackSnapshot s#) = fromJust mbStackSnapshot + stackClosure <- getClosureData s# + stackFrames <- mapM getBoxedClosureData (stack stackClosure) + + assertStackInvariants stackSnapshot stackFrames + assertThat + "Stack contains one big return frame" + (== 1) + (length $ filter isBigReturnFrame stackFrames) + cs <- (mapM unbox . payload . head) $ filter isBigReturnFrame stackFrames + let xs = zip [1 ..] cs + mapM_ (uncurry checkArg) xs + +checkArg :: Word -> Closure -> IO () +checkArg w bp = + case bp of + UnknownTypeWordSizedPrimitive _ -> error "Unexpected payload type from bitmap." + c -> do + assertEqual CONSTR_0_1 $ (tipe . info) c + assertEqual "I#" (name c) + assertEqual "ghc-prim" (pkg c) + assertEqual "GHC.Types" (modl c) + assertEqual True $ (null . ptrArgs) c + assertEqual [w] (dataArgs c) + pure () + +isBigReturnFrame (RetBig info _) = tipe info == RET_BIG +isBigReturnFrame _ = False + +{-# NOINLINE bigFun #-} +bigFun :: + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + IO () +bigFun !a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24 a25 a26 a27 a28 a29 a30 a31 a32 a33 a34 a35 a36 a37 a38 a39 a40 a41 a42 a43 a44 a45 a46 a47 a48 a49 a50 a51 a52 a53 a54 a55 a56 a57 a58 a59 a60 a61 a62 a63 a64 a65 = + do + print $ a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + a10 + a11 + a12 + a13 + a14 + a15 + a16 + a17 + a18 + a19 + a20 + a21 + a22 + a23 + a24 + a25 + a26 + a27 + a28 + a29 + a30 + a31 + a32 + a33 + a34 + a35 + a36 + a37 + a38 + a39 + a40 + a41 + a42 + a43 + a44 + a45 + a46 + a47 + a48 + a49 + a50 + a51 + a52 + a53 + a54 + a55 + a56 + a57 + a58 + a59 + a60 + a61 + a62 + a63 + a64 + a65 + + pure () ===================================== libraries/ghc-heap/tests/stack_misc_closures.hs ===================================== @@ -0,0 +1,553 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedDatatypes #-} +{-# LANGUAGE UnliftedFFITypes #-} + +module Main where + +-- TODO: Remove later +import Debug.Trace +import GHC.Exts +import GHC.Exts.DecodeStack +import GHC.Exts.Heap +import GHC.Exts.Heap.Closures +import GHC.IO (IO (..)) +import GHC.Stack (HasCallStack) +import GHC.Stack.CloneStack (StackSnapshot (..)) +import System.Mem +import TestUtils +import Unsafe.Coerce (unsafeCoerce) +import Data.Functor + +foreign import prim "any_update_framezh" any_update_frame# :: SetupFunction + +foreign import prim "any_catch_framezh" any_catch_frame# :: SetupFunction + +foreign import prim "any_catch_stm_framezh" any_catch_stm_frame# :: SetupFunction + +foreign import prim "any_catch_retry_framezh" any_catch_retry_frame# :: SetupFunction + +foreign import prim "any_atomically_framezh" any_atomically_frame# :: SetupFunction + +foreign import prim "any_ret_small_prim_framezh" any_ret_small_prim_frame# :: SetupFunction + +foreign import prim "any_ret_small_prims_framezh" any_ret_small_prims_frame# :: SetupFunction + +foreign import prim "any_ret_small_closure_framezh" any_ret_small_closure_frame# :: SetupFunction + +foreign import prim "any_ret_small_closures_framezh" any_ret_small_closures_frame# :: SetupFunction + +foreign import prim "any_ret_big_prims_min_framezh" any_ret_big_prims_min_frame# :: SetupFunction + +foreign import prim "any_ret_big_closures_min_framezh" any_ret_big_closures_min_frame# :: SetupFunction + +foreign import prim "any_ret_big_closures_two_words_framezh" any_ret_big_closures_two_words_frame# :: SetupFunction + +foreign import prim "any_ret_fun_arg_n_prim_framezh" any_ret_fun_arg_n_prim_framezh# :: SetupFunction + +foreign import prim "any_ret_fun_arg_gen_framezh" any_ret_fun_arg_gen_framezh# :: SetupFunction + +foreign import prim "any_ret_fun_arg_gen_big_framezh" any_ret_fun_arg_gen_big_framezh# :: SetupFunction + +foreign import prim "any_bco_framezh" any_bco_frame# :: SetupFunction + +foreign import prim "any_underflow_framezh" any_underflow_frame# :: SetupFunction + +foreign import ccall "maxSmallBitmapBits" maxSmallBitmapBits_c :: Word + +foreign import ccall "belchStack" belchStack# :: StackSnapshot# -> IO () + +{- Test stategy + ~~~~~~~~~~~~ + +- Create @StgStack at s in C that contain two closures (as they are on stack they +may also be called "frames"). A stop frame and the frame which's decoding should +be tested. + +- Cmm primops are used to get `StackSnapshot#` values. (This detour ensures that +the closures are referenced by `StackSnapshot#` and not garbage collected right +away.) + +- These can then be decoded and checked. + +This strategy may look pretty complex for a test. But, it can provide very +specific corner cases that would be hard to (reliably!) produce in Haskell. + +N.B. `StackSnapshots` are managed by the garbage collector. This isn't much of +an issue regarding the test data, as it's already very terse. However, it's +important to know that the GC may rewrite parts of the stack and that the stack +must be sound (otherwise, the GC may fail badly.) + +The decission to make `StackSnapshots`s (and their closures) being managed by the +GC isn't accidential. It's closer to the reality of decoding stacks. + +N.B. the test data stack are only meant be de decoded. They are not executable +(the result would likely be a crash or non-sense.) +-} +main :: HasCallStack => IO () +main = do + traceM $ "Test 1" + test any_update_frame# $ + \case + UpdateFrame {..} -> do + assertEqual (tipe info) UPDATE_FRAME + assertEqual knownUpdateFrameType NormalUpdateFrame + assertEqual 1 =<< (getWordFromBlackhole =<< getBoxedClosureData updatee) + e -> error $ "Wrong closure type: " ++ show e + traceM $ "Test 2" + testSize any_update_frame# 2 + traceM $ "Test 3" + test any_catch_frame# $ + \case + CatchFrame {..} -> do + assertEqual (tipe info) CATCH_FRAME + assertEqual exceptions_blocked 1 + assertConstrClosure 1 =<< getBoxedClosureData handler + e -> error $ "Wrong closure type: " ++ show e + traceM $ "Test 4" + testSize any_catch_frame# 3 + traceM $ "Test 5" + test any_catch_stm_frame# $ + \case + CatchStmFrame {..} -> do + assertEqual (tipe info) CATCH_STM_FRAME + assertConstrClosure 1 =<< getBoxedClosureData catchFrameCode + assertConstrClosure 2 =<< getBoxedClosureData handler + e -> error $ "Wrong closure type: " ++ show e + traceM $ "Test 6" + testSize any_catch_stm_frame# 3 + traceM $ "Test 7" + test any_catch_retry_frame# $ + \case + CatchRetryFrame {..} -> do + assertEqual (tipe info) CATCH_RETRY_FRAME + assertEqual running_alt_code 1 + assertConstrClosure 1 =<< getBoxedClosureData first_code + assertConstrClosure 2 =<< getBoxedClosureData alt_code + e -> error $ "Wrong closure type: " ++ show e + traceM $ "Test 8" + testSize any_catch_retry_frame# 4 + traceM $ "Test 9" + test any_atomically_frame# $ + \case + AtomicallyFrame {..} -> do + assertEqual (tipe info) ATOMICALLY_FRAME + assertConstrClosure 1 =<< getBoxedClosureData atomicallyFrameCode + assertConstrClosure 2 =<< getBoxedClosureData result + e -> error $ "Wrong closure type: " ++ show e + traceM $ "Test 10" + testSize any_atomically_frame# 3 + -- TODO: Test for UnderflowFrame once it points to a Box payload + traceM $ "Test 11" + test any_ret_small_prim_frame# $ + \case + RetSmall {..} -> do + assertEqual (tipe info) RET_SMALL + assertEqual knownRetSmallType RetN + pCs <- mapM getBoxedClosureData payload + assertEqual (length pCs) 1 + assertUnknownTypeWordSizedPrimitive 1 (head pCs) + e -> error $ "Wrong closure type: " ++ show e + traceM $ "Test 12" + testSize any_ret_small_prim_frame# 2 + traceM $ "Test 13" + test any_ret_small_closure_frame# $ + \case + RetSmall {..} -> do + assertEqual (tipe info) RET_SMALL + assertEqual knownRetSmallType RetP + pCs <- mapM getBoxedClosureData payload + assertEqual (length pCs) 1 + assertConstrClosure 1 (head pCs) + e -> error $ "Wrong closure type: " ++ show e + traceM $ "Test 14" + testSize any_ret_small_closure_frame# 2 + traceM $ "Test 15" + test any_ret_small_closures_frame# $ + \case + RetSmall {..} -> do + assertEqual (tipe info) RET_SMALL + assertEqual knownRetSmallType None + pCs <- mapM getBoxedClosureData payload + assertEqual (length pCs) (fromIntegral maxSmallBitmapBits_c) + let wds = map getWordFromConstr01 pCs + assertEqual wds [1 .. 58] + e -> error $ "Wrong closure type: " ++ show e + traceM $ "Test 16" + testSize any_ret_small_closures_frame# (1 + fromIntegral maxSmallBitmapBits_c) + traceM $ "Test 17" + test any_ret_small_prims_frame# $ + \case + RetSmall {..} -> do + assertEqual (tipe info) RET_SMALL + assertEqual knownRetSmallType None + pCs <- mapM getBoxedClosureData payload + assertEqual (length pCs) (fromIntegral maxSmallBitmapBits_c) + let wds = map getWordFromUnknownTypeWordSizedPrimitive pCs + assertEqual wds [1 .. 58] + e -> error $ "Wrong closure type: " ++ show e + traceM $ "Test 18" + testSize any_ret_small_prims_frame# (1 + fromIntegral maxSmallBitmapBits_c) + traceM $ "Test 19" + test any_ret_big_prims_min_frame# $ + \case + RetBig {..} -> do + assertEqual (tipe info) RET_BIG + pCs <- mapM getBoxedClosureData payload + assertEqual (length pCs) 59 + let wds = map getWordFromUnknownTypeWordSizedPrimitive pCs + assertEqual wds [1 .. 59] + e -> error $ "Wrong closure type: " ++ show e + traceM $ "Test 20" + testSize any_ret_big_prims_min_frame# (minBigBitmapBits + 1) + traceM $ "Test 21" + test any_ret_big_closures_min_frame# $ + \case + RetBig {..} -> do + assertEqual (tipe info) RET_BIG + pCs <- mapM getBoxedClosureData payload + assertEqual (length pCs) 59 + let wds = map getWordFromConstr01 pCs + assertEqual wds [1 .. 59] + e -> error $ "Wrong closure type: " ++ show e + traceM $ "Test 22" + testSize any_ret_big_closures_min_frame# (minBigBitmapBits + 1) + traceM $ "Test 23" + test any_ret_big_closures_two_words_frame# $ + \case + RetBig {..} -> do + assertEqual (tipe info) RET_BIG + pCs <- mapM getBoxedClosureData payload + let closureCount = 64 + 1 + assertEqual (length pCs) closureCount + let wds = map getWordFromConstr01 pCs + assertEqual wds [1 .. (fromIntegral closureCount)] + e -> error $ "Wrong closure type: " ++ show e + traceM $ "Test 24" + testSize any_ret_big_closures_two_words_frame# (64 + 1 + 1) + traceM $ "Test 25" + test any_ret_fun_arg_n_prim_framezh# $ + \case + RetFun {..} -> do + assertEqual (tipe info) RET_FUN + assertEqual retFunType ARG_N + assertEqual retFunSize 1 + assertFun01Closure 1 =<< getBoxedClosureData retFunFun + pCs <- mapM getBoxedClosureData retFunPayload + assertEqual (length pCs) 1 + let wds = map getWordFromUnknownTypeWordSizedPrimitive pCs + assertEqual wds [1] + e -> error $ "Wrong closure type: " ++ show e + traceM $ "Test 26" + test any_ret_fun_arg_gen_framezh# $ + \case + RetFun {..} -> do + assertEqual (tipe info) RET_FUN + assertEqual retFunType ARG_GEN + assertEqual retFunSize 9 + fc <- getBoxedClosureData retFunFun + case fc of + FunClosure {..} -> do + assertEqual (tipe info) FUN_STATIC + assertEqual (null dataArgs) True + assertEqual (null ptrArgs) True + e -> error $ "Wrong closure type: " ++ show e + pCs <- mapM getBoxedClosureData retFunPayload + assertEqual (length pCs) 9 + let wds = map getWordFromConstr01 pCs + assertEqual wds [1 .. 9] + e -> error $ "Wrong closure type: " ++ show e + traceM $ "Test 27" + testSize any_ret_fun_arg_gen_framezh# (3 + 9) + traceM $ "Test 28" + test any_ret_fun_arg_gen_big_framezh# $ + \case + RetFun {..} -> do + assertEqual (tipe info) RET_FUN + assertEqual retFunType ARG_GEN_BIG + assertEqual retFunSize 59 + fc <- getBoxedClosureData retFunFun + case fc of + FunClosure {..} -> do + assertEqual (tipe info) FUN_STATIC + assertEqual (null dataArgs) True + assertEqual (null ptrArgs) True + e -> error $ "Wrong closure type: " ++ show e + pCs <- mapM getBoxedClosureData retFunPayload + assertEqual (length pCs) 59 + let wds = map getWordFromConstr01 pCs + assertEqual wds [1 .. 59] + traceM $ "Test 29" + testSize any_ret_fun_arg_gen_big_framezh# (3 + 59) + traceM $ "Test 30" + test any_bco_frame# $ + \case + RetBCO {..} -> do + assertEqual (tipe info) RET_BCO + pCs <- mapM getBoxedClosureData bcoArgs + assertEqual (length pCs) 1 + let wds = map getWordFromConstr01 pCs + assertEqual wds [3] + bco <- getBoxedClosureData bco + case bco of + BCOClosure {..} -> do + assertEqual (tipe info) BCO + assertEqual arity 3 + assertArrWordsClosure [1] =<< getBoxedClosureData instrs + assertArrWordsClosure [2] =<< getBoxedClosureData literals + assertMutArrClosure [3] =<< getBoxedClosureData bcoptrs + assertEqual + [ 1, -- StgLargeBitmap size in words + 0 -- StgLargeBitmap first words + ] + bitmap + e -> error $ "Wrong closure type: " ++ show e + e -> error $ "Wrong closure type: " ++ show e + traceM $ "Test 31" + testSize any_bco_frame# 3 + traceM $ "Test 32" + test any_underflow_frame# $ + \case + UnderflowFrame {..} -> do + assertEqual (tipe info) UNDERFLOW_FRAME + nextStack <- getBoxedClosureData nextChunk + case nextStack of + StackClosure {..} -> do + assertEqual (tipe info) STACK + assertEqual stack_size 27 + assertEqual stack_dirty 0 + assertEqual stack_marking 0 + nextStackClosures <- mapM getBoxedClosureData stack + assertEqual (length nextStackClosures) 2 + case head nextStackClosures of + RetSmall {..} -> + assertEqual (tipe info) RET_SMALL + e -> error $ "Wrong closure type: " ++ show e + case last nextStackClosures of + StopFrame {..} -> + assertEqual (tipe info) STOP_FRAME + e -> error $ "Wrong closure type: " ++ show e + e -> error $ "Wrong closure type: " ++ show e + e -> error $ "Wrong closure type: " ++ show e + testSize any_underflow_frame# 2 + +type SetupFunction = State# RealWorld -> (# State# RealWorld, StackSnapshot# #) + +test :: HasCallStack => SetupFunction -> (Closure -> IO ()) -> IO () +test setup assertion = do + traceM $ "test - getStackSnapshot" + sn@(StackSnapshot sn#) <- getStackSnapshot setup + traceM $ "test - sn " ++ show sn + performGC + traceM $ "entertainGC - " ++ (entertainGC 10) + -- Run garbage collection now, to prevent later surprises: It's hard to debug + -- when the GC suddenly does it's work and there were bad closures or pointers. + -- Better fail early, here. + performGC + traceM $ "test - sn' " ++ show sn + stackClosure <- getClosureData sn# + traceM $ "test - ss" ++ show stackClosure + performGC + traceM $ "call getBoxedClosureData" + let boxedFrames = stack stackClosure + stack <- mapM getBoxedClosureData boxedFrames + performGC + assert sn stack + -- The result of HasHeapRep should be similar (wrapped in the closure for + -- StgStack itself.) + let (StackSnapshot sn#) = sn + stack' <- getClosureData sn# + case stack' of + StackClosure {..} -> do + !cs <- mapM getBoxedClosureData stack + assert sn cs + _ -> error $ "Unexpected closure type : " ++ show stack' + where + assert :: StackSnapshot -> [Closure] -> IO () + assert sn stack = do + assertStackInvariants sn stack + assertEqual (length stack) 2 + -- TODO: Isn't this also a stack invariant? (assertStackInvariants) + assertThat + "Last frame is stop frame" + ( \case + StopFrame info -> tipe info == STOP_FRAME + _ -> False + ) + (last stack) + assertion $ head stack + +entertainGC :: Int -> String +entertainGC 0 = "0" +entertainGC x = show x ++ entertainGC (x -1) + +testSize :: HasCallStack => SetupFunction -> Int -> IO () +testSize setup expectedSize = do + (StackSnapshot sn#) <- getStackSnapshot setup + stackClosure <- getClosureData sn# + assertEqual expectedSize =<< (closureSize . head . stack) stackClosure + +-- | Get a `StackSnapshot` from test setup +-- +-- This function mostly resembles `cloneStack`. Though, it doesn't clone, but +-- just pulls a @StgStack@ from RTS to Haskell land. +getStackSnapshot :: SetupFunction -> IO StackSnapshot +getStackSnapshot action# = IO $ \s -> + case action# s of (# s1, stack #) -> (# s1, StackSnapshot stack #) + +assertConstrClosure :: HasCallStack => Word -> Closure -> IO () +assertConstrClosure w c = case c of + ConstrClosure {..} -> do + assertEqual (tipe info) CONSTR_0_1 + assertEqual dataArgs [w] + assertEqual (null ptrArgs) True + e -> error $ "Wrong closure type: " ++ show e + +assertArrWordsClosure :: HasCallStack => [Word] -> Closure -> IO () +assertArrWordsClosure wds c = case c of + ArrWordsClosure {..} -> do + assertEqual (tipe info) ARR_WORDS + assertEqual arrWords wds + e -> error $ "Wrong closure type: " ++ show e + +assertMutArrClosure :: HasCallStack => [Word] -> Closure -> IO () +assertMutArrClosure wds c = case c of + MutArrClosure {..} -> do + assertEqual (tipe info) MUT_ARR_PTRS_FROZEN_CLEAN + xs <- mapM getBoxedClosureData mccPayload + assertEqual wds $ map getWordFromConstr01 xs + e -> error $ "Wrong closure type: " ++ show e + +assertFun01Closure :: HasCallStack => Word -> Closure -> IO () +assertFun01Closure w c = case c of + FunClosure {..} -> do + assertEqual (tipe info) FUN_0_1 + assertEqual dataArgs [w] + assertEqual (null ptrArgs) True + e -> error $ "Wrong closure type: " ++ show e + +getWordFromConstr01 :: HasCallStack => Closure -> Word +getWordFromConstr01 c = case c of + ConstrClosure {..} -> head dataArgs + e -> error $ "Wrong closure type: " ++ show e + +getWordFromBlackhole :: HasCallStack => Closure -> IO Word +getWordFromBlackhole c = case c of + BlackholeClosure {..} -> getWordFromConstr01 <$> getBoxedClosureData indirectee + -- For test stability reasons: Expect that the blackhole might have been + -- resolved. + ConstrClosure {..} -> pure $ head dataArgs + e -> error $ "Wrong closure type: " ++ show e + +getWordFromUnknownTypeWordSizedPrimitive :: HasCallStack => Closure -> Word +getWordFromUnknownTypeWordSizedPrimitive c = case c of + UnknownTypeWordSizedPrimitive {..} -> wordVal + e -> error $ "Wrong closure type: " ++ show e + +assertUnknownTypeWordSizedPrimitive :: HasCallStack => Word -> Closure -> IO () +assertUnknownTypeWordSizedPrimitive w c = case c of + UnknownTypeWordSizedPrimitive {..} -> do + assertEqual wordVal w + e -> error $ "Wrong closure type: " ++ show e + +unboxSingletonTuple :: (# StackSnapshot# #) -> StackSnapshot# +unboxSingletonTuple (# s# #) = s# + +minBigBitmapBits :: Num a => a +minBigBitmapBits = 1 + fromIntegral maxSmallBitmapBits_c + +-- | A function with 59 arguments +-- +-- A small bitmap has @64 - 6 = 58@ entries on 64bit machines. On 32bit machines +-- it's less (for obvious reasons.) I.e. this function's bitmap a large one; +-- function type is @ARG_GEN_BIG at . +{-# NOINLINE argGenBigFun #-} +argGenBigFun :: + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word +argGenBigFun a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24 a25 a26 a27 a28 a29 a30 a31 a32 a33 a34 a35 a36 a37 a38 a39 a40 a41 a42 a43 a44 a45 a46 a47 a48 a49 a50 a51 a52 a53 a54 a55 a56 a57 a58 a59 = + a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + a10 + a11 + a12 + a13 + a14 + a15 + a16 + a17 + a18 + a19 + a20 + a21 + a22 + a23 + a24 + a25 + a26 + a27 + a28 + a29 + a30 + a31 + a32 + a33 + a34 + a35 + a36 + a37 + a38 + a39 + a40 + a41 + a42 + a43 + a44 + a45 + a46 + a47 + a48 + a49 + a50 + a51 + a52 + a53 + a54 + a55 + a56 + a57 + a58 + a59 + +-- | A function with more arguments than the pre-generated (@ARG_PPPPPPPP -> 8@) ones +-- have +-- +-- This results in a @ARG_GEN@ function (the number of arguments still fits in a +-- small bitmap). +{-# NOINLINE argGenFun #-} +argGenFun :: + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word +argGenFun a1 a2 a3 a4 a5 a6 a7 a8 a9 = a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 ===================================== libraries/ghc-heap/tests/stack_misc_closures_c.c ===================================== @@ -0,0 +1,371 @@ +#include "MachDeps.h" +#include "Rts.h" +#include "RtsAPI.h" +#include "alloca.h" +#include "rts/Messages.h" +#include "rts/Types.h" +#include "rts/storage/ClosureMacros.h" +#include "rts/storage/Closures.h" +#include "rts/storage/InfoTables.h" +#include "rts/storage/TSO.h" +#include "stg/MiscClosures.h" +#include "stg/Types.h" + +// TODO: Delete when development finished +extern void printStack(StgStack *stack); +extern void printObj(StgClosure *obj); + +// See rts/Threads.c +#define MIN_STACK_WORDS (RESERVED_STACK_WORDS + sizeofW(StgStopFrame) + 3) + +// Copied from Cmm.h +#define SIZEOF_W SIZEOF_VOID_P +#define WDS(n) ((n)*SIZEOF_W) + +// Update frames are interpreted by the garbage collector. We play it some +// tricks here with a fake blackhole. +RTS_RET(test_fake_blackhole); +void create_any_update_frame(Capability *cap, StgStack *stack, StgWord w) { + StgUpdateFrame *updF = (StgUpdateFrame *)stack->sp; + SET_HDR(updF, &stg_upd_frame_info, CCS_SYSTEM); + // StgInd and a BLACKHOLE have the same structure + StgInd *blackhole = allocate(cap, sizeofW(StgInd)); + SET_HDR(blackhole, &test_fake_blackhole_info, CCS_SYSTEM); + StgClosure *payload = rts_mkWord(cap, w); + blackhole->indirectee = payload; + updF->updatee = (StgClosure *)blackhole; +} + +void create_any_catch_frame(Capability *cap, StgStack *stack, StgWord w) { + StgCatchFrame *catchF = (StgCatchFrame *)stack->sp; + SET_HDR(catchF, &stg_catch_frame_info, CCS_SYSTEM); + StgClosure *payload = rts_mkWord(cap, w); + catchF->exceptions_blocked = 1; + catchF->handler = payload; +} + +void create_any_catch_stm_frame(Capability *cap, StgStack *stack, StgWord w) { + StgCatchSTMFrame *catchF = (StgCatchSTMFrame *)stack->sp; + SET_HDR(catchF, &stg_catch_stm_frame_info, CCS_SYSTEM); + StgClosure *payload1 = rts_mkWord(cap, w); + StgClosure *payload2 = rts_mkWord(cap, w + 1); + catchF->code = payload1; + catchF->handler = payload2; +} + +// TODO: Use `w` for running_alt_code, too. +void create_any_catch_retry_frame(Capability *cap, StgStack *stack, StgWord w) { + StgCatchRetryFrame *catchRF = (StgCatchRetryFrame *)stack->sp; + SET_HDR(catchRF, &stg_catch_retry_frame_info, CCS_SYSTEM); + StgClosure *payload1 = rts_mkWord(cap, w); + StgClosure *payload2 = rts_mkWord(cap, w + 1); + catchRF->running_alt_code = 1; + catchRF->first_code = payload1; + catchRF->alt_code = payload2; +} + +void create_any_atomically_frame(Capability *cap, StgStack *stack, StgWord w) { + StgAtomicallyFrame *aF = (StgAtomicallyFrame *)stack->sp; + SET_HDR(aF, &stg_atomically_frame_info, CCS_SYSTEM); + StgClosure *payload1 = rts_mkWord(cap, w); + StgClosure *payload2 = rts_mkWord(cap, w + 1); + aF->code = payload1; + aF->result = payload2; +} + +void create_any_ret_small_prim_frame(Capability *cap, StgStack *stack, + StgWord w) { + StgClosure *c = (StgClosure *)stack->sp; + SET_HDR(c, &stg_ret_n_info, CCS_SYSTEM); + // The cast is a lie (w is interpreted as plain Word, not as pointer), but the + // memory layout fits. + c->payload[0] = (StgClosure *)w; +} + +void create_any_ret_small_closure_frame(Capability *cap, StgStack *stack, + StgWord w) { + StgClosure *c = (StgClosure *)stack->sp; + SET_HDR(c, &stg_ret_p_info, CCS_SYSTEM); + StgClosure *payload = rts_mkWord(cap, w); + c->payload[0] = payload; +} + +#define MAX_SMALL_BITMAP_BITS (BITS_IN(W_) - BITMAP_BITS_SHIFT) + +StgWord maxSmallBitmapBits() { return MAX_SMALL_BITMAP_BITS; } + +RTS_RET(test_small_ret_full_p); +void create_any_ret_small_closures_frame(Capability *cap, StgStack *stack, + StgWord w) { + StgClosure *c = (StgClosure *)stack->sp; + SET_HDR(c, &test_small_ret_full_p_info, CCS_SYSTEM); + for (int i = 0; i < MAX_SMALL_BITMAP_BITS; i++) { + StgClosure *payload1 = UNTAG_CLOSURE(rts_mkWord(cap, w)); + w++; + c->payload[i] = payload1; + } +} + +RTS_RET(test_small_ret_full_n); +void create_any_ret_small_prims_frame(Capability *cap, StgStack *stack, + StgWord w) { + StgClosure *c = (StgClosure *)stack->sp; + SET_HDR(c, &test_small_ret_full_n_info, CCS_SYSTEM); + for (int i = 0; i < MAX_SMALL_BITMAP_BITS; i++) { + c->payload[i] = (StgClosure *)w; + w++; + } +} + +#define MIN_LARGE_BITMAP_BITS (MAX_SMALL_BITMAP_BITS + 1) + +RTS_RET(test_big_ret_min_n); +void create_any_ret_big_prims_min_frame(Capability *cap, StgStack *stack, + StgWord w) { + StgClosure *c = (StgClosure *)stack->sp; + SET_HDR(c, &test_big_ret_min_n_info, CCS_SYSTEM); + + for (int i = 0; i < MIN_LARGE_BITMAP_BITS; i++) { + c->payload[i] = (StgClosure *)w; + w++; + } +} + +RTS_RET(test_big_ret_min_p); +void create_any_ret_big_closures_min_frame(Capability *cap, StgStack *stack, + StgWord w) { + StgClosure *c = (StgClosure *)stack->sp; + SET_HDR(c, &test_big_ret_min_p_info, CCS_SYSTEM); + + for (int i = 0; i < MIN_LARGE_BITMAP_BITS; i++) { + c->payload[i] = UNTAG_CLOSURE(rts_mkWord(cap, w)); + w++; + } +} + +#define TWO_WORDS_LARGE_BITMAP_BITS (BITS_IN(W_) + 1) + +RTS_RET(test_big_ret_two_words_p); +void create_any_ret_big_closures_two_words_frame(Capability *cap, + StgStack *stack, StgWord w) { + StgClosure *c = (StgClosure *)stack->sp; + SET_HDR(c, &test_big_ret_two_words_p_info, CCS_SYSTEM); + + for (int i = 0; i < TWO_WORDS_LARGE_BITMAP_BITS; i++) { + c->payload[i] = UNTAG_CLOSURE(rts_mkWord(cap, w)); + w++; + } +} + +RTS_RET(test_ret_fun); +RTS_RET(test_arg_n_fun_0_1); +void create_any_ret_fun_arg_n_prim_frame(Capability *cap, StgStack *stack, + StgWord w) { + StgRetFun *c = (StgRetFun *)stack->sp; + c->info = &test_ret_fun_info; + StgClosure *f = + (StgClosure *)allocate(cap, sizeofW(StgClosure) + sizeofW(StgWord)); + SET_HDR(f, &test_arg_n_fun_0_1_info, ccs) + c->fun = f; + const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(c->fun)); + c->size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]); + // The cast is a lie (w is interpreted as plain Word, not as pointer), but the + // memory layout fits. + c->payload[0] = (StgClosure *)w; + f->payload[0] = (StgClosure *)w; +} + +RTS_CLOSURE(Main_argGenFun_closure); +void create_any_ret_fun_arg_gen_frame(Capability *cap, StgStack *stack, + StgWord w) { + StgRetFun *c = (StgRetFun *)stack->sp; + c->info = &test_ret_fun_info; + c->fun = &Main_argGenFun_closure; + const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(c->fun)); + c->size = BITMAP_SIZE(fun_info->f.b.bitmap); + for (int i = 0; i < c->size; i++) { + c->payload[i] = rts_mkWord(cap, w++); + } +} + +RTS_CLOSURE(Main_argGenBigFun_closure); +void create_any_ret_fun_arg_gen_big_frame(Capability *cap, StgStack *stack, + StgWord w) { + StgRetFun *c = (StgRetFun *)stack->sp; + c->info = &test_ret_fun_info; + c->fun = &Main_argGenBigFun_closure; + const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(c->fun)); + c->size = GET_FUN_LARGE_BITMAP(fun_info)->size; + for (int i = 0; i < c->size; i++) { + c->payload[i] = rts_mkWord(cap, w++); + } +} + +RTS_RET(test_ret_bco); +void create_any_bco_frame(Capability *cap, StgStack *stack, StgWord w) { + StgClosure *c = (StgClosure *)stack->sp; + SET_HDR(c, &test_ret_bco_info, CCS_SYSTEM); + StgWord bcoSizeWords = sizeofW(StgBCO) + sizeofW(StgLargeBitmap) + sizeofW(StgWord); + StgBCO *bco = allocate(cap, bcoSizeWords); + SET_HDR(bco, &stg_BCO_info, CCS_MAIN); + c->payload[0] = (StgClosure *)bco; + + bco->size = bcoSizeWords; + bco->arity = 3; + + StgArrBytes *instrs = + (StgArrBytes *)allocate(cap, sizeofW(StgArrBytes) + sizeofW(StgWord)); + SET_HDR(instrs, &stg_ARR_WORDS_info, CCCS); + instrs->bytes = WDS(1); + instrs->payload[0] = w++; + bco->instrs = instrs; + + StgArrBytes *literals = + (StgArrBytes *)allocate(cap, sizeofW(StgArrBytes) + sizeofW(StgWord)); + SET_HDR(literals, &stg_ARR_WORDS_info, CCCS); + bco->literals = literals; + literals->bytes = WDS(1); + literals->payload[0] = w++; + bco->literals = literals; + + StgWord ptrsSize = 1 + mutArrPtrsCardTableSize(1); + StgMutArrPtrs *ptrs = allocate(cap, sizeofW(StgMutArrPtrs) + ptrsSize); + SET_HDR(ptrs, &stg_MUT_ARR_PTRS_FROZEN_CLEAN_info, ccs); + ptrs->ptrs = 1; + ptrs->size = ptrsSize; + ptrs->payload[0] = rts_mkWord(cap, w); + bco->ptrs = ptrs; + + StgLargeBitmap *bitmap = (StgLargeBitmap *)bco->bitmap; + bitmap->size = 1; + bitmap->bitmap[0] = 0; // set bit 0 to 0 indicating a closure + c->payload[1] = (StgClosure *)rts_mkWord(cap, w); +} + +StgStack *any_ret_small_prim_frame(Capability *cap); + +void create_any_underflow_frame(Capability *cap, StgStack *stack, StgWord w) { + StgUnderflowFrame *underflowF = (StgUnderflowFrame *)stack->sp; + underflowF->info = &stg_stack_underflow_frame_info; + underflowF->next_chunk = any_ret_small_prim_frame(cap); +} + +// Import from Sanity.c +extern void checkSTACK(StgStack *stack); + +// Basically, a stripped down version of createThread() (regarding stack +// creation) +StgStack *setup(Capability *cap, StgWord closureSizeWords, + void (*f)(Capability *, StgStack *, StgWord)) { + StgWord totalSizeWords = + sizeofW(StgStack) + closureSizeWords + MIN_STACK_WORDS; + StgStack *stack = (StgStack *)allocate(cap, totalSizeWords); + SET_HDR(stack, &stg_STACK_info, CCS_SYSTEM); + stack->stack_size = totalSizeWords - sizeofW(StgStack); + stack->dirty = 0; + stack->marking = 0; + + StgPtr spBottom = stack->stack + stack->stack_size; + stack->sp = spBottom; + stack->sp -= sizeofW(StgStopFrame); + SET_HDR((StgClosure *)stack->sp, &stg_stop_thread_info, CCS_SYSTEM); + stack->sp -= closureSizeWords; + + // Pointers can easíly be confused with each other. Provide a start value for + // values (1) in closures and increment it after every usage. The goal is to + // have distinct values in the closure to ensure nothing gets mixed up. + f(cap, stack, 1); + + // Make a sanitiy check to find unsound closures before the GC and the decode + // code. + checkSTACK(stack); + return stack; +} + +StgStack *any_update_frame(Capability *cap) { + return setup(cap, sizeofW(StgUpdateFrame), &create_any_update_frame); +} + +StgStack *any_catch_frame(Capability *cap) { + return setup(cap, sizeofW(StgCatchFrame), &create_any_catch_frame); +} + +StgStack *any_catch_stm_frame(Capability *cap) { + return setup(cap, sizeofW(StgCatchSTMFrame), &create_any_catch_stm_frame); +} + +StgStack *any_catch_retry_frame(Capability *cap) { + return setup(cap, sizeofW(StgCatchRetryFrame), &create_any_catch_retry_frame); +} + +StgStack *any_atomically_frame(Capability *cap) { + return setup(cap, sizeofW(StgAtomicallyFrame), &create_any_atomically_frame); +} + +StgStack *any_ret_small_prim_frame(Capability *cap) { + return setup(cap, sizeofW(StgClosure) + sizeofW(StgWord), + &create_any_ret_small_prim_frame); +} + +StgStack *any_ret_small_closure_frame(Capability *cap) { + return setup(cap, sizeofW(StgClosure) + sizeofW(StgClosurePtr), + &create_any_ret_small_closure_frame); +} + +StgStack *any_ret_small_closures_frame(Capability *cap) { + return setup( + cap, sizeofW(StgClosure) + MAX_SMALL_BITMAP_BITS * sizeofW(StgClosurePtr), + &create_any_ret_small_closures_frame); +} + +StgStack *any_ret_small_prims_frame(Capability *cap) { + return setup(cap, + sizeofW(StgClosure) + MAX_SMALL_BITMAP_BITS * sizeofW(StgWord), + &create_any_ret_small_prims_frame); +} + +StgStack *any_ret_big_closures_min_frame(Capability *cap) { + return setup( + cap, sizeofW(StgClosure) + MIN_LARGE_BITMAP_BITS * sizeofW(StgClosure), + &create_any_ret_big_closures_min_frame); +} + +StgStack *any_ret_big_closures_two_words_frame(Capability *cap) { + return setup(cap, + sizeofW(StgClosure) + + TWO_WORDS_LARGE_BITMAP_BITS * sizeofW(StgClosure), + &create_any_ret_big_closures_two_words_frame); +} + +StgStack *any_ret_big_prims_min_frame(Capability *cap) { + return setup(cap, + sizeofW(StgClosure) + MIN_LARGE_BITMAP_BITS * sizeofW(StgWord), + &create_any_ret_big_prims_min_frame); +} + +StgStack *any_ret_fun_arg_n_prim_frame(Capability *cap) { + return setup(cap, sizeofW(StgRetFun) + sizeofW(StgWord), + &create_any_ret_fun_arg_n_prim_frame); +} + +StgStack *any_ret_fun_arg_gen_frame(Capability *cap) { + return setup(cap, sizeofW(StgRetFun) + 9 * sizeofW(StgClosure), + &create_any_ret_fun_arg_gen_frame); +} + +StgStack *any_ret_fun_arg_gen_big_frame(Capability *cap) { + return setup(cap, sizeofW(StgRetFun) + 59 * sizeofW(StgWord), + &create_any_ret_fun_arg_gen_big_frame); +} + +StgStack *any_bco_frame(Capability *cap) { + return setup(cap, sizeofW(StgClosure) + 2 * sizeofW(StgWord), + &create_any_bco_frame); +} + +StgStack *any_underflow_frame(Capability *cap) { + return setup(cap, sizeofW(StgUnderflowFrame), + &create_any_underflow_frame); +} + +void belchStack(StgStack *stack) { printStack(stack); } ===================================== libraries/ghc-heap/tests/stack_misc_closures_prim.cmm ===================================== @@ -0,0 +1,231 @@ +#include "Cmm.h" + +any_update_framezh() { + P_ stack; + ("ptr" stack) = ccall any_update_frame(MyCapability() "ptr"); + return (stack); +} + +any_catch_framezh() { + P_ stack; + (stack) = ccall any_catch_frame(MyCapability() "ptr"); + return (stack); +} + +any_catch_stm_framezh() { + P_ stack; + (stack) = ccall any_catch_stm_frame(MyCapability() "ptr"); + return (stack); +} + +any_catch_retry_framezh() { + P_ stack; + (stack) = ccall any_catch_retry_frame(MyCapability() "ptr"); + return (stack); +} + +any_atomically_framezh() { + P_ stack; + (stack) = ccall any_atomically_frame(MyCapability() "ptr"); + return (stack); +} + +any_ret_small_prim_framezh() { + P_ stack; + (stack) = ccall any_ret_small_prim_frame(MyCapability() "ptr"); + return (stack); +} + +any_ret_small_prims_framezh() { + P_ stack; + (stack) = ccall any_ret_small_prims_frame(MyCapability() "ptr"); + return (stack); +} + +any_ret_small_closure_framezh() { + P_ stack; + (stack) = ccall any_ret_small_closure_frame(MyCapability() "ptr"); + return (stack); +} + +any_ret_small_closures_framezh() { + P_ stack; + (stack) = ccall any_ret_small_closures_frame(MyCapability() "ptr"); + return (stack); +} + +any_ret_big_prims_min_framezh() { + P_ stack; + (stack) = ccall any_ret_big_prims_min_frame(MyCapability() "ptr"); + return (stack); +} + +any_ret_big_closures_min_framezh() { + P_ stack; + (stack) = ccall any_ret_big_closures_min_frame(MyCapability() "ptr"); + return (stack); +} + +any_ret_big_closures_two_words_framezh() { + P_ stack; + (stack) = ccall any_ret_big_closures_two_words_frame(MyCapability() "ptr"); + return (stack); +} + +any_ret_fun_arg_n_prim_framezh() { + P_ stack; + (stack) = ccall any_ret_fun_arg_n_prim_frame(MyCapability() "ptr"); + return (stack); +} + +any_ret_fun_arg_gen_framezh() { + P_ stack; + (stack) = ccall any_ret_fun_arg_gen_frame(MyCapability() "ptr"); + return (stack); +} + +any_ret_fun_arg_gen_big_framezh() { + P_ stack; + (stack) = ccall any_ret_fun_arg_gen_big_frame(MyCapability() "ptr"); + return (stack); +} + +any_bco_framezh() { + P_ stack; + (stack) = ccall any_bco_frame(MyCapability() "ptr"); + return (stack); +} + +any_underflow_framezh() { + P_ stack; + (stack) = ccall any_underflow_frame(MyCapability() "ptr"); + return (stack); +} + +INFO_TABLE_RET ( test_small_ret_full_p, RET_SMALL, W_ info_ptr, +#if SIZEOF_VOID_P == 4 +P_ ptr1, P_ ptr2, P_ ptr3, P_ ptr4, P_ ptr5, P_ ptr6, P_ ptr7, P_ ptr8, P_ ptr9, P_ ptr10, +P_ ptr11, P_ ptr12, P_ ptr13, P_ ptr14, P_ ptr15, P_ ptr16, P_ ptr17, P_ ptr18, P_ ptr19, P_ ptr20, +P_ ptr21, P_ ptr22, P_ ptr23, P_ ptr24, P_ ptr25, P_ ptr26, P_ ptr27 +) +#elif SIZEOF_VOID_P == 8 +P_ ptr1, P_ ptr2, P_ ptr3, P_ ptr4, P_ ptr5, P_ ptr6, P_ ptr7, P_ ptr8, P_ ptr9, P_ ptr10, +P_ ptr11, P_ ptr12, P_ ptr13, P_ ptr14, P_ ptr15, P_ ptr16, P_ ptr17, P_ ptr18, P_ ptr19, P_ ptr20, +P_ ptr21, P_ ptr22, P_ ptr23, P_ ptr24, P_ ptr25, P_ ptr26, P_ ptr27, P_ ptr28, P_ ptr29, P_ ptr30, +P_ ptr31, P_ ptr32, P_ ptr33, P_ ptr34, P_ ptr35, P_ ptr36, P_ ptr37, P_ ptr38, P_ ptr39, P_ ptr40, +P_ ptr41, P_ ptr42, P_ ptr43, P_ ptr44, P_ ptr45, P_ ptr46, P_ ptr47, P_ ptr48, P_ ptr49, P_ ptr50, +P_ ptr51, P_ ptr52, P_ ptr53, P_ ptr54, P_ ptr55, P_ ptr56, P_ ptr57, P_ ptr58 +) +#endif + return (/* no return values */) +{ + return (); +} + +INFO_TABLE_RET ( test_small_ret_full_n, RET_SMALL, W_ info_ptr, +#if SIZEOF_VOID_P == 4 +W_ n1, W_ n2, W_ n3, W_ n4, W_ n5, W_ n6, W_ n7, W_ n8, W_ n9, W_ n10, +W_ n11, W_ n12, W_ n13, W_ n14, W_ n15, W_ n16, W_ n17, W_ n18, W_ n19, W_ n20, +W_ n21, W_ n22, W_ n23, W_ n24, W_ n25, W_ n26, W_ n27 +) +#elif SIZEOF_VOID_P == 8 +W_ n1, W_ n2, W_ n3, W_ n4, W_ n5, W_ n6, W_ n7, W_ n8, W_ n9, W_ n10, +W_ n11, W_ n12, W_ n13, W_ n14, W_ n15, W_ n16, W_ n17, W_ n18, W_ n19, W_ n20, +W_ n21, W_ n22, W_ n23, W_ n24, W_ n25, W_ n26, W_ n27, W_ n28, W_ n29, W_ n30, +W_ n31, W_ n32, W_ n33, W_ n34, W_ n35, W_ n36, W_ n37, W_ n38, W_ n39, W_ n40, +W_ n41, W_ n42, W_ n43, W_ n44, W_ n45, W_ n46, W_ n47, W_ n48, W_ n49, W_ n50, +W_ n51, W_ n52, W_ n53, W_ n54, W_ n55, W_ n56, W_ n57, W_ n58 +) +#endif + return (/* no return values */) +{ + return (); +} + +// Size of this large bitmap closure is: max size of small bitmap + 1 +INFO_TABLE_RET ( test_big_ret_min_n, RET_BIG, W_ info_ptr, +#if SIZEOF_VOID_P == 4 +W_ n1, W_ n2, W_ n3, W_ n4, W_ n5, W_ n6, W_ n7, W_ n8, W_ n9, W_ n10, +W_ n11, W_ n12, W_ n13, W_ n14, W_ n15, W_ n16, W_ n17, W_ n18, W_ n19, W_ n20, +W_ n21, W_ n22, W_ n23, W_ n24, W_ n25, W_ n26, W_ n27, W_ n28 +#elif SIZEOF_VOID_P == 8 +W_ n1, W_ n2, W_ n3, W_ n4, W_ n5, W_ n6, W_ n7, W_ n8, W_ n9, W_ n10, +W_ n11, W_ n12, W_ n13, W_ n14, W_ n15, W_ n16, W_ n17, W_ n18, W_ n19, W_ n20, +W_ n21, W_ n22, W_ n23, W_ n24, W_ n25, W_ n26, W_ n27, W_ n28, W_ n29, W_ n30, +W_ n31, W_ n32, W_ n33, W_ n34, W_ n35, W_ n36, W_ n37, W_ n38, W_ n39, W_ n40, +W_ n41, W_ n42, W_ n43, W_ n44, W_ n45, W_ n46, W_ n47, W_ n48, W_ n49, W_ n50, +W_ n51, W_ n52, W_ n53, W_ n54, W_ n55, W_ n56, W_ n57, W_ n58, W_ n59 +#endif +) + return (/* no return values */) +{ + return (); +} + +// Size of this large bitmap closure is: max size of small bitmap + 1 +INFO_TABLE_RET ( test_big_ret_min_p, RET_BIG, W_ info_ptr, +#if SIZEOF_VOID_P == 4 +P_ p1, P_ p2, P_ p3, P_ p4, P_ p5, P_ p6, P_ p7, P_ p8, P_ p9, P_ p10, +P_ p11, P_ p12, P_ p13, P_ p14, P_ p15, P_ p16, P_ p17, P_ p18, P_ p19, P_ p20, +P_ p21, P_ p22, P_ p23, P_ p24, P_ p25, P_ p26, P_ p27, P_ p28 +#elif SIZEOF_VOID_P == 8 +P_ p1, P_ p2, P_ p3, P_ p4, P_ p5, P_ p6, P_ p7, P_ p8, P_ p9, P_ p10, +P_ p11, P_ p12, P_ p13, P_ p14, P_ p15, P_ p16, P_ p17, P_ p18, P_ p19, P_ p20, +P_ p21, P_ p22, P_ p23, P_ p24, P_ p25, P_ p26, P_ p27, P_ p28, P_ p29, P_ p30, +P_ p31, P_ p32, P_ p33, P_ p34, P_ p35, P_ p36, P_ p37, P_ p38, P_ p39, P_ p40, +P_ p41, P_ p42, P_ p43, P_ p44, P_ p45, P_ p46, P_ p47, P_ p48, P_ p49, P_ p50, +P_ p51, P_ p52, P_ p53, P_ p54, P_ p55, P_ p56, P_ p57, P_ p58, P_ p59 +#endif +) + return (/* no return values */) +{ + return (); +} + +// Size of this large bitmap closure is: max size of bits in word + 1 +// This results in a two word StgLargeBitmap. +INFO_TABLE_RET ( test_big_ret_two_words_p, RET_BIG, W_ info_ptr, +#if SIZEOF_VOID_P == 4 +P_ p1, P_ p2, P_ p3, P_ p4, P_ p5, P_ p6, P_ p7, P_ p8, P_ p9, P_ p10, +P_ p11, P_ p12, P_ p13, P_ p14, P_ p15, P_ p16, P_ p17, P_ p18, P_ p19, P_ p20, +P_ p21, P_ p22, P_ p23, P_ p24, P_ p25, P_ p26, P_ p27, P_ p28, P_ p29, P_ p30, +P_ p31, P_ p32, P_ p33 +#elif SIZEOF_VOID_P == 8 +P_ p1, P_ p2, P_ p3, P_ p4, P_ p5, P_ p6, P_ p7, P_ p8, P_ p9, P_ p10, +P_ p11, P_ p12, P_ p13, P_ p14, P_ p15, P_ p16, P_ p17, P_ p18, P_ p19, P_ p20, +P_ p21, P_ p22, P_ p23, P_ p24, P_ p25, P_ p26, P_ p27, P_ p28, P_ p29, P_ p30, +P_ p31, P_ p32, P_ p33, P_ p34, P_ p35, P_ p36, P_ p37, P_ p38, P_ p39, P_ p40, +P_ p41, P_ p42, P_ p43, P_ p44, P_ p45, P_ p46, P_ p47, P_ p48, P_ p49, P_ p50, +P_ p51, P_ p52, P_ p53, P_ p54, P_ p55, P_ p56, P_ p57, P_ p58, P_ p59, P_ p60, +P_ p61, P_ p62, P_ p63, P_ p64, P_ p65 +#endif +) + return (/* no return values */) +{ + return (); +} + +// A BLACKHOLE without any code. Just a placeholder to keep the GC happy. +INFO_TABLE(test_fake_blackhole,1,0,BLACKHOLE,"BLACKHOLE","BLACKHOLE") + (P_ node) +{ + return (); +} + +INFO_TABLE_RET ( test_ret_fun, RET_FUN, W_ info_ptr, W_ size, P_ fun, P_ payload) + return (/* no return values */) +{ + return (); +} + +INFO_TABLE_FUN ( test_arg_n_fun_0_1, 0 , 0, FUN_0_1, "FUN_0_1", "FUN_0_1", 1, ARG_N) + return (/* no return values */) +{ + return (); +} + +INFO_TABLE_RET( test_ret_bco, RET_BCO) + return (/* no return values */) +{ + return (); +} ===================================== libraries/ghc-heap/tests/stack_stm_frames.hs ===================================== @@ -0,0 +1,38 @@ +{-# LANGUAGE RecordWildCards #-} + +module Main where + +import Control.Concurrent.STM +import Control.Exception +import GHC.Conc +import GHC.Exts.DecodeStack +import GHC.Exts.Heap.ClosureTypes +import GHC.Exts.Heap.Closures +import GHC.Exts.Heap.InfoTable.Types +import GHC.Stack.CloneStack +import TestUtils +import GHC.Exts.Heap + +main :: IO () +main = do + (stackSnapshot, decodedStack) <- + atomically $ + catchSTM @SomeException (unsafeIOToSTM getDecodedStack) throwSTM + + assertStackInvariants stackSnapshot decodedStack + assertThat + "Stack contains one catch stm frame" + (== 1) + (length $ filter isCatchStmFrame decodedStack) + assertThat + "Stack contains one atomically frame" + (== 1) + (length $ filter isAtomicallyFrame decodedStack) + +isCatchStmFrame :: Closure -> Bool +isCatchStmFrame (CatchStmFrame {..}) = tipe info == CATCH_STM_FRAME +isCatchStmFrame _ = False + +isAtomicallyFrame :: Closure -> Bool +isAtomicallyFrame (AtomicallyFrame {..}) = tipe info == ATOMICALLY_FRAME +isAtomicallyFrame _ = False ===================================== libraries/ghc-heap/tests/stack_underflow.hs ===================================== @@ -0,0 +1,48 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE RecordWildCards #-} + +module Main where + +import Data.Bool (Bool (True)) +import GHC.Exts.DecodeStack +import GHC.Exts.Heap +import GHC.Exts.Heap.ClosureTypes +import GHC.Exts.Heap.Closures +import GHC.Exts.Heap.InfoTable.Types +import GHC.Stack (HasCallStack) +import GHC.Stack.CloneStack +import TestUtils + +main = loop 128 + +{-# NOINLINE loop #-} +loop 0 = () <$ getStack +loop n = print "x" >> loop (n - 1) >> print "x" + +getStack :: HasCallStack => IO () +getStack = do + (s, decodedStack) <- getDecodedStack + -- Uncomment to see the frames (for debugging purposes) + -- hPutStrLn stderr $ "Stack frames : " ++ show decodedStack + assertStackInvariants s decodedStack + assertThat + "Stack contains underflow frames" + (== True) + (any isUnderflowFrame decodedStack) + assertStackChunksAreDecodable decodedStack + return () + +isUnderflowFrame (UnderflowFrame {..}) = tipe info == UNDERFLOW_FRAME +isUnderflowFrame _ = False + +assertStackChunksAreDecodable :: HasCallStack => [Closure] -> IO () +assertStackChunksAreDecodable s = do + let underflowFrames = filter isUnderflowFrame s + stackClosures <- mapM (getBoxedClosureData . nextChunk) underflowFrames + let stackBoxes = map stack stackClosures + framesOfChunks <- sequence (map (mapM getBoxedClosureData) stackBoxes) + assertThat + "No empty stack chunks" + (== True) + ( not (any null framesOfChunks) + ) ===================================== libraries/ghci/GHCi/Message.hs ===================================== @@ -1,6 +1,6 @@ {-# LANGUAGE GADTs, DeriveGeneric, StandaloneDeriving, ScopedTypeVariables, GeneralizedNewtypeDeriving, ExistentialQuantification, RecordWildCards, - CPP #-} + CPP, MagicHash, TypeApplications #-} {-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-orphans #-} -- | @@ -53,7 +53,11 @@ import qualified Language.Haskell.TH.Syntax as TH import System.Exit import System.IO import System.IO.Error - +#if MIN_VERSION_base(4,17,0) +import GHC.Stack.CloneStack +import GHC.Word (Word(W#)) +import GHC.Exts (Word#, unsafeCoerce#, StackSnapshot#) +#endif -- ----------------------------------------------------------------------------- -- The RPC protocol between GHC and the interactive server @@ -471,6 +475,21 @@ instance Binary Heap.WhyBlocked instance Binary Heap.TsoFlags #endif +#if MIN_VERSION_base(4,17,0) +instance Binary Heap.SpecialRetSmall +instance Binary Heap.UpdateFrameType +instance Binary Heap.RetFunType +-- TODO: Revisit this. This instance is pretty hacky (unsafeCoerce# ...) +instance Binary StackSnapshot where + get = do + v <- get @Word + pure $ StackSnapshot (toPrim v) + where + toPrim :: Word -> StackSnapshot# + toPrim (W# w#) = unsafeCoerce# w# + put (StackSnapshot s#) = put (W# ((unsafeCoerce# s#) :: Word#)) +#endif + instance Binary Heap.StgInfoTable instance Binary Heap.ClosureType instance Binary Heap.PrimType ===================================== libraries/ghci/GHCi/Run.hs ===================================== @@ -1,5 +1,5 @@ {-# LANGUAGE GADTs, RecordWildCards, MagicHash, ScopedTypeVariables, CPP, - UnboxedTuples #-} + UnboxedTuples, LambdaCase #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} -- | @@ -94,7 +94,11 @@ run m = case m of StartTH -> startTH GetClosure ref -> do clos <- Heap.getClosureData =<< localRef ref - mapM (\(Heap.Box x) -> mkRemoteRef (HValue x)) clos + mapM (\case + Heap.Box x -> mkRemoteRef (HValue x) + -- TODO: Is this unsafeCoerce really necessary? + Heap.StackFrameBox d -> mkRemoteRef (HValue (unsafeCoerce d)) + ) clos Seq ref -> doSeq ref ResumeSeq ref -> resumeSeq ref _other -> error "GHCi.Run.run" ===================================== rts/Heap.c ===================================== @@ -12,6 +12,7 @@ #include "Capability.h" #include "Printer.h" +#include "rts/storage/InfoTables.h" StgWord heap_view_closureSize(StgClosure *closure) { ASSERT(LOOKS_LIKE_CLOSURE_PTR(closure)); @@ -256,7 +257,6 @@ StgWord collect_pointers(StgClosure *closure, StgClosure *ptrs[]) { StgMutArrPtrs *heap_view_closurePtrs(Capability *cap, StgClosure *closure) { ASSERT(LOOKS_LIKE_CLOSURE_PTR(closure)); - StgWord size = heap_view_closureSize(closure); // First collect all pointers here, with the comfortable memory bound ===================================== rts/PrimOps.cmm ===================================== @@ -2518,7 +2518,6 @@ stg_unpackClosurezh ( P_ closure ) W_ clos; clos = UNTAG(closure); - W_ len; // The array returned, dat_arr, is the raw data for the entire closure. // The length is variable based upon the closure type, ptrs, and non-ptrs ===================================== rts/Printer.c ===================================== @@ -260,6 +260,7 @@ printClosure( const StgClosure *obj ) case UPDATE_FRAME: { StgUpdateFrame* u = (StgUpdateFrame*)obj; + debugBelch("printObj - frame %p, indirectee %p\n", u, u->updatee); debugBelch("%s(", info_update_frame(obj)); printPtr((StgPtr)GET_INFO((StgClosure *)u)); debugBelch(","); @@ -279,6 +280,32 @@ printClosure( const StgClosure *obj ) break; } + case CATCH_STM_FRAME: + { + StgCatchSTMFrame* c = (StgCatchSTMFrame*)obj; + debugBelch("CATCH_STM_FRAME("); + printPtr((StgPtr)GET_INFO((StgClosure *)c)); + debugBelch(","); + printPtr((StgPtr)c->code); + debugBelch(","); + printPtr((StgPtr)c->handler); + debugBelch(")\n"); + break; + } + + case ATOMICALLY_FRAME : + { + StgAtomicallyFrame* f = (StgAtomicallyFrame*)obj; + debugBelch("ATOMICALLY_FRAME("); + printPtr((StgPtr)GET_INFO((StgClosure *)f)); + debugBelch(","); + printPtr((StgPtr)f->code); + debugBelch(","); + printPtr((StgPtr)f->result); + debugBelch(")\n"); + break; + } + case UNDERFLOW_FRAME: { StgUnderflowFrame* u = (StgUnderflowFrame*)obj; @@ -464,6 +491,7 @@ const char *info_update_frame(const StgClosure *closure) // it pointing to the code or struct members when compiling with // TABLES_NEXT_TO_CODE. const StgInfoTable *info = closure->header.info; + debugBelch("info_update_frame - closure %p, info %p\n", closure, info); if (info == &stg_upd_frame_info) { return "NORMAL_UPDATE_FRAME"; } else if (info == &stg_bh_upd_frame_info) { @@ -474,21 +502,46 @@ const char *info_update_frame(const StgClosure *closure) return "ERROR: Not an update frame!!!"; } } +// TODO: Remove later +// Assumes little endian +void printBits(size_t const size, void const * const ptr) +{ + unsigned char *b = (unsigned char*) ptr; + unsigned char byte; + int i, j; + + for (i = size-1; i >= 0; i--) { + for (j = 7; j >= 0; j--) { + byte = (b[i] >> j) & 1; + debugBelch("%u", byte); + } + } + debugBelch("\n"); +} + +StgPtr origSp = NULL; static void printSmallBitmap( StgPtr spBottom, StgPtr payload, StgWord bitmap, uint32_t size ) { + debugBelch("printSmallBitmap - payload %p\n", payload); + debugBelch("printSmallBitmap - bitmap "); + printBits(sizeof(StgWord), &bitmap); + debugBelch("printSmallBitmap - size %u, bitmap %ul\n", size, bitmap); + uint32_t i; for(i = 0; i < size; i++, bitmap >>= 1 ) { + debugBelch("printSmallBitmap - index %ld\n", &payload[i] - origSp); debugBelch(" stk[%ld] (%p) = ", (long)(spBottom-(payload+i)), payload+i); if ((bitmap & 1) == 0) { + debugBelch("closure - "); printPtr((P_)payload[i]); debugBelch(" -- "); printObj((StgClosure*) payload[i]); } else { - debugBelch("Word# %" FMT_Word "\n", (W_)payload[i]); + debugBelch("primitive - Word# %" FMT_Word "\n", (W_)payload[i]); } } } @@ -503,36 +556,44 @@ printLargeBitmap( StgPtr spBottom, StgPtr payload, StgLargeBitmap* large_bitmap, i = 0; for (bmp=0; i < size; bmp++) { StgWord bitmap = large_bitmap->bitmap[bmp]; + debugBelch("printLargeBitmap - bitmap no %ul, bits ", bmp); + printBits(sizeof(StgWord), &bitmap); j = 0; for(; i < size && j < BITS_IN(W_); j++, i++, bitmap >>= 1 ) { debugBelch(" stk[%" FMT_Word "] (%p) = ", (W_)(spBottom-(payload+i)), payload+i); if ((bitmap & 1) == 0) { + debugBelch("closure - "); printPtr((P_)payload[i]); debugBelch(" -- "); printObj((StgClosure*) payload[i]); } else { - debugBelch("Word# %" FMT_Word "\n", (W_)payload[i]); + debugBelch("primitive - Word# %" FMT_Word "\n", (W_)payload[i]); } } } } + void printStackChunk( StgPtr sp, StgPtr spBottom ) { const StgInfoTable *info; + origSp = sp; ASSERT(sp <= spBottom); for (; sp < spBottom; sp += stack_frame_sizeW((StgClosure *)sp)) { - info = get_itbl((StgClosure *)sp); + debugBelch("printStackChunk - closure size : %lu , sp : %p, spBottom %p, info ptr %p, itbl type %ul \n", stack_frame_sizeW((StgClosure *)sp), sp, spBottom, info, info->type); + debugBelch("printStackChunk - index: %ld \n", sp - origSp); switch (info->type) { + case UNDERFLOW_FRAME: case UPDATE_FRAME: case CATCH_FRAME: - case UNDERFLOW_FRAME: case STOP_FRAME: + case CATCH_STM_FRAME: + case ATOMICALLY_FRAME: printClosure((StgClosure*)sp); continue; @@ -590,6 +651,7 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) debugBelch("RET_SMALL (%p)\n", info); } StgWord bitmap = info->layout.bitmap; + debugBelch("printStackChunk - RET_SMALL - bitmap: %lu \n", bitmap); printSmallBitmap(spBottom, sp+1, BITMAP_BITS(bitmap), BITMAP_SIZE(bitmap)); continue; @@ -648,7 +710,10 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) case RET_BIG: debugBelch("RET_BIG (%p)\n", sp); + debugBelch("payload ptr : %p \n", (StgPtr)((StgClosure *) sp)->payload); StgLargeBitmap* bitmap = GET_LARGE_BITMAP(info); + debugBelch("bitmap ptr %p\n", bitmap); + debugBelch("bitmap size %ul\n", bitmap->size); printLargeBitmap(spBottom, (StgPtr)((StgClosure *) sp)->payload, bitmap, @@ -664,17 +729,18 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) debugBelch("RET_FUN (%p) (type=%d)\n", ret_fun->fun, (int)fun_info->f.fun_type); switch (fun_info->f.fun_type) { case ARG_GEN: - printSmallBitmap(spBottom, sp+2, + printSmallBitmap(spBottom, sp+3, BITMAP_BITS(fun_info->f.b.bitmap), BITMAP_SIZE(fun_info->f.b.bitmap)); break; case ARG_GEN_BIG: - printLargeBitmap(spBottom, sp+2, + printLargeBitmap(spBottom, sp+3, GET_FUN_LARGE_BITMAP(fun_info), GET_FUN_LARGE_BITMAP(fun_info)->size); break; default: - printSmallBitmap(spBottom, sp+2, + // sp + 3 because the payload's offset is 24 + printSmallBitmap(spBottom, sp+3, BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]), BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type])); break; @@ -691,6 +757,8 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) void printStack( StgStack *stack ) { + debugBelch("printStack - stack %p, sp %p, size %ul, bottom %p\n", stack, stack->sp, stack->stack_size, stack->stack + stack->stack_size); + printStackChunk( stack->sp, stack->stack + stack->stack_size ); } ===================================== rts/RtsSymbols.c ===================================== @@ -985,6 +985,7 @@ extern char **environ; SymI_HasDataProto(stg_unpack_cstring_info) \ SymI_HasDataProto(stg_unpack_cstring_utf8_info) \ SymI_HasDataProto(stg_upd_frame_info) \ + SymI_HasDataProto(stg_marked_upd_frame_info) \ SymI_HasDataProto(stg_bh_upd_frame_info) \ SymI_HasProto(suspendThread) \ SymI_HasDataProto(stg_takeMVarzh) \ ===================================== rts/include/rts/storage/InfoTables.h ===================================== @@ -122,7 +122,7 @@ extern const StgWord16 closure_flags[]; /* * A large bitmap. */ -typedef struct { +typedef struct StgLargeBitmap_ { StgWord size; StgWord bitmap[]; } StgLargeBitmap; ===================================== rts/sm/Sanity.c ===================================== @@ -42,7 +42,6 @@ int isHeapAlloced ( StgPtr p); static void checkSmallBitmap ( StgPtr payload, StgWord bitmap, uint32_t ); static void checkLargeBitmap ( StgPtr payload, StgLargeBitmap*, uint32_t ); static void checkClosureShallow ( const StgClosure * ); -static void checkSTACK (StgStack *stack); static W_ countNonMovingSegments ( struct NonmovingSegment *segs ); static W_ countNonMovingHeap ( struct NonmovingHeap *heap ); @@ -63,6 +62,7 @@ checkSmallBitmap( StgPtr payload, StgWord bitmap, uint32_t size ) { uint32_t i; + debugBelch("checkSmallBitmap - payload %p , bitmap %lu, size %u\n", payload, bitmap, size); for(i = 0; i < size; i++, bitmap >>= 1 ) { if ((bitmap & 1) == 0) { checkClosureShallow((StgClosure *)payload[i]); @@ -713,7 +713,7 @@ checkCompactObjects(bdescr *bd) } } -static void +void checkSTACK (StgStack *stack) { StgPtr sp = stack->sp; @@ -1325,5 +1325,9 @@ memInventory (bool show) } - +//TODO: Remove after debugging +#else +void +checkSTACK (StgStack *stack){} +void checkSanity (bool after_gc, bool major_gc){} #endif /* DEBUG */ ===================================== rts/sm/Sanity.h ===================================== @@ -39,6 +39,7 @@ void memInventory (bool show); void checkBQ (StgTSO *bqe, StgClosure *closure); +void checkSTACK (StgStack *stack); #include "EndPrivate.h" #endif /* DEBUG */ ===================================== utils/deriveConstants/Main.hs ===================================== @@ -476,6 +476,7 @@ wanteds os = concat ,closureFieldOffset Both "StgStack" "stack" ,closureField C "StgStack" "stack_size" ,closureField C "StgStack" "dirty" + ,closureField C "StgStack" "marking" ,structSize C "StgTSOProfInfo" @@ -484,6 +485,11 @@ wanteds os = concat ,closureField C "StgCatchFrame" "handler" ,closureField C "StgCatchFrame" "exceptions_blocked" + ,structSize C "StgRetFun" + ,fieldOffset C "StgRetFun" "size" + ,fieldOffset C "StgRetFun" "fun" + ,fieldOffset C "StgRetFun" "payload" + ,closureSize C "StgPAP" ,closureField C "StgPAP" "n_args" ,closureFieldGcptr C "StgPAP" "fun" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d5eca62068019172d87da9451cde56bf527141c3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d5eca62068019172d87da9451cde56bf527141c3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Feb 4 16:09:55 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sat, 04 Feb 2023 11:09:55 -0500 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] 350 commits: Add heqT, a kind-heterogeneous variant of heq Message-ID: <63de83535852a_1108fe193a73988211d0@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: b3e98a92 by Oleg Grenrus at 2022-12-11T12:26:17-05:00 Add heqT, a kind-heterogeneous variant of heq CLC proposal https://github.com/haskell/core-libraries-committee/issues/99 - - - - - bfd7c1e6 by Bodigrim at 2022-12-11T12:26:55-05:00 Document that Bifunctor instances for tuples are lawful only up to laziness - - - - - 5d1a1881 by Bryan Richter at 2022-12-12T16:22:36-05:00 Mark T21336a fragile - - - - - c30accc2 by Matthew Pickering at 2022-12-12T16:23:11-05:00 Add test for #21476 This issues seems to have been fixed since the ticket was made, so let's add a test and move on. Fixes #21476 - - - - - e9d74a3e by Sebastian Graf at 2022-12-13T22:18:39-05:00 Respect -XStrict in the pattern-match checker (#21761) We were missing a call to `decideBangHood` in the pattern-match checker. There is another call in `matchWrapper.mk_eqn_info` which seems redundant but really is not; see `Note [Desugaring -XStrict matches in Pmc]`. Fixes #21761. - - - - - 884790e2 by Gergő Érdi at 2022-12-13T22:19:14-05:00 Fix loop in the interface representation of some `Unfolding` fields As discovered in #22272, dehydration of the unfolding info of a recursive definition used to involve a traversal of the definition itself, which in turn involves traversing the unfolding info. Hence, a loop. Instead, we now store enough data in the interface that we can produce the unfolding info without this traversal. See Note [Tying the 'CoreUnfolding' knot] for details. Fixes #22272 Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 9f301189 by Alan Zimmerman at 2022-12-13T22:19:50-05:00 EPA: When splitting out header comments, keep ones for first decl Any comments immediately preceding the first declaration are no longer kept as header comments, but attach to the first declaration instead. - - - - - 8b1f1b45 by Sylvain Henry at 2022-12-13T22:20:28-05:00 JS: fix object file name comparison (#22578) - - - - - e9e161bb by Bryan Richter at 2022-12-13T22:21:03-05:00 configure: Bump min bootstrap GHC version to 9.2 - - - - - 75855643 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Don't enable TSAN in stage0 build - - - - - da7b51d8 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce blockConcat - - - - - 34f6b09c by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce MemoryOrderings - - - - - 43beaa7b by Ben Gamari at 2022-12-15T03:54:02-05:00 llvm: Respect memory specified orderings - - - - - 8faf74fc by Ben Gamari at 2022-12-15T03:54:02-05:00 Codegen/x86: Eliminate barrier for relaxed accesses - - - - - 6cc3944a by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Reduce some repetition - - - - - 6c9862c4 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Add syntax for ordered loads and stores - - - - - 748490d2 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Atomic load syntax Originally I had thought I would just use the `prim` call syntax instead of introducing new syntax for atomic loads. However, it turns out that `prim` call syntax tends to make things quite unreadable. This new syntax seems quite natural. - - - - - 28c6781a by Ben Gamari at 2022-12-15T03:54:02-05:00 codeGen: Introduce ThreadSanitizer instrumentation This introduces a new Cmm pass which instruments the program with ThreadSanitizer annotations, allowing full tracking of mutator memory accesses via TSAN. - - - - - d97aa311 by Ben Gamari at 2022-12-15T03:54:02-05:00 Hadrian: Drop TSAN_ENABLED define from flavour This is redundant since the TSANUtils.h already defines it. - - - - - 86974ef1 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Enable Cmm instrumentation in TSAN flavour - - - - - 93723290 by Ben Gamari at 2022-12-15T03:54:02-05:00 rts: Ensure that global regs are never passed as fun call args This is in general unsafe as they may be clobbered if they are mapped to caller-saved machine registers. See Note [Register parameter passing]. - - - - - 2eb0fb87 by Matthew Pickering at 2022-12-15T03:54:39-05:00 Package Imports: Get candidate packages also from re-exported modules Previously we were just looking at the direct imports to try and work out what a package qualifier could apply to but #22333 pointed out we also needed to look for reexported modules. Fixes #22333 - - - - - 552b7908 by Ben Gamari at 2022-12-15T03:55:15-05:00 compiler: Ensure that MutVar operations have necessary barriers Here we add acquire and release barriers in readMutVar# and writeMutVar#, which are necessary for soundness. Fixes #22468. - - - - - 933d61a4 by Simon Peyton Jones at 2022-12-15T03:55:51-05:00 Fix bogus test in Lint The Lint check for branch compatiblity within an axiom, in GHC.Core.Lint.compatible_branches was subtly different to the check made when contructing an axiom, in GHC.Core.FamInstEnv.compatibleBranches. The latter is correct, so I killed the former and am now using the latter. On the way I did some improvements to pretty-printing and documentation. - - - - - 03ed0b95 by Ryan Scott at 2022-12-15T03:56:26-05:00 checkValidInst: Don't expand synonyms when splitting sigma types Previously, the `checkValidInst` function (used when checking that an instance declaration is headed by an actual type class, not a type synonym) was using `tcSplitSigmaTy` to split apart the `forall`s and instance context. This is incorrect, however, as `tcSplitSigmaTy` expands type synonyms, which can cause instances headed by quantified constraint type synonyms to be accepted erroneously. This patch introduces `splitInstTyForValidity`, a variant of `tcSplitSigmaTy` specialized for validity checking that does _not_ expand type synonyms, and uses it in `checkValidInst`. Fixes #22570. - - - - - ed056bc3 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/Messages: Refactor This doesn't change behavior but makes the code a bit easier to follow. - - - - - 7356f8e0 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/ThreadPaused: Ordering fixes - - - - - 914f0025 by Ben Gamari at 2022-12-16T16:12:44-05:00 eventlog: Silence spurious data race - - - - - fbc84244 by Ben Gamari at 2022-12-16T16:12:44-05:00 Introduce SET_INFO_RELEASE for Cmm - - - - - 821b5472 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Use fences instead of explicit barriers - - - - - 2228c999 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/stm: Fix memory ordering in readTVarIO# See #22421. - - - - - 99269b9f by Ben Gamari at 2022-12-16T16:12:44-05:00 Improve heap memory barrier Note Also introduce MUT_FIELD marker in Closures.h to document mutable fields. - - - - - 70999283 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Introduce getNumCapabilities And ensure accesses to n_capabilities are atomic (although with relaxed ordering). This is necessary as RTS API callers may concurrently call into the RTS without holding a capability. - - - - - 98689f77 by Ben Gamari at 2022-12-16T16:12:44-05:00 ghc: Fix data race in dump file handling Previously the dump filename cache would use a non-atomic update which could potentially result in lost dump contents. Note that this is still a bit racy since the first writer may lag behind a later appending writer. - - - - - 605d9547 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Always use atomics for context_switch and interrupt Since these are modified by the timer handler. - - - - - 86f20258 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts/Timer: Always use atomic operations As noted in #22447, the existence of the pthread-based ITimer implementation means that we cannot assume that the program is single-threaded. - - - - - f8e901dc by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate recent_activity access This makes it easier to ensure that it is accessed using the necessary atomic operations. - - - - - e0affaa9 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate access to capabilities array - - - - - 7ca683e4 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate sched_state - - - - - 1cf13bd0 by Ben Gamari at 2022-12-16T16:12:45-05:00 PrimOps: Fix benign MutVar race Relaxed ordering is fine here since the later CAS implies a release. - - - - - 3d2a7e08 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Style fix - - - - - 82c62074 by Ben Gamari at 2022-12-16T16:12:45-05:00 compiler: Use release store in eager blackholing - - - - - eb1a0136 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Fix ordering of makeStableName - - - - - ad0e260a by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Use ordered accesses instead of explicit barriers - - - - - a3eccf06 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Statically allocate capabilities This is a rather simplistic way of solving #17289. - - - - - 287fa3fb by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Ensure that all accesses to pending_sync are atomic - - - - - 351eae58 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Note race with wakeBlockingQueue - - - - - 5acf33dd by Bodigrim at 2022-12-16T16:13:22-05:00 Bump submodule directory to 1.3.8.0 and hpc to HEAD - - - - - 0dd95421 by Bodigrim at 2022-12-16T16:13:22-05:00 Accept allocations increase on Windows This is because of `filepath-1.4.100.0` and AFPP, causing increasing round-trips between lists and ByteArray. See #22625 for discussion. Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T10547 T12150 T12227 T12234 T12425 T13035 T13253 T13253-spj T13701 T13719 T15703 T16875 T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T21839r T5837 T6048 T9198 T9961 TcPlugin_RewritePerf hard_hole_fits - - - - - ef9ac9d2 by Cheng Shao at 2022-12-16T16:13:59-05:00 testsuite: Mark T9405 as fragile instead of broken on Windows It's starting to pass again, and the unexpected pass blocks CI. - - - - - 1f3abd85 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: remove obsolete commented code in wasm NCG It was just a temporary hack to workaround a bug in the relooper, that bug has been fixed long before the wasm backend is merged. - - - - - e3104eab by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add missing export list of GHC.CmmToAsm.Wasm.FromCmm Also removes some unreachable code here. - - - - - 1c6930bf by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: change fallback function signature to Cmm function signature in wasm NCG In the wasm NCG, when handling a `CLabel` of undefined function without knowing its function signature, we used to fallback to `() -> ()` which is accepted by `wasm-ld`. This patch changes it to the signature of Cmm functions, which equally works, but would be required when we emit tail call instructions. - - - - - 8a81d9d9 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add optional tail-call support in wasm NCG When the `-mtail-call` clang flag is passed at configure time, wasm tail-call extension is enabled, and the wasm NCG will emit `return_call`/`return_call_indirect` instructions to take advantage of it and avoid the `StgRun` trampoline overhead. Closes #22461. - - - - - d1431cc0 by Cheng Shao at 2022-12-17T08:07:15-05:00 base: add missing autoconf checks for waitpid/umask These are not present in wasi-libc. Required for fixing #22589 - - - - - da3f1e91 by Cheng Shao at 2022-12-17T08:07:51-05:00 compiler: make .wasm the default executable extension on wasm32 Following convention as in other wasm toolchains. Fixes #22594. - - - - - ad21f4ef by Cheng Shao at 2022-12-17T08:07:51-05:00 ci: support hello.wasm in ci.sh cross testing logic - - - - - 6fe2d778 by amesgen at 2022-12-18T19:33:49-05:00 Correct `exitWith` Haddocks The `IOError`-specific `catch` in the Prelude is long gone. - - - - - b3eacd64 by Ben Gamari at 2022-12-18T19:34:24-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 761c1f49 by Ben Gamari at 2022-12-18T19:35:00-05:00 rts/libdw: Silence uninitialized usage warnings As noted in #22538, previously some GCC versions warned that various locals in Libdw.c may be used uninitialized. Although this wasn't strictly true (since they were initialized in an inline assembler block) we fix this by providing explicit empty initializers. Fixes #22538 - - - - - 5e047eff by Matthew Pickering at 2022-12-20T15:12:04+00:00 testsuite: Mark T16392 as fragile on windows See #22649 - - - - - 703a4665 by M Farkas-Dyck at 2022-12-20T21:14:46-05:00 Scrub some partiality in `GHC.Cmm.Info.Build`: `doSRTs` takes a `[(CAFSet, CmmDecl)]` but truly wants a `[(CAFSet, CmmStatics)]`. - - - - - 9736ab74 by Matthew Pickering at 2022-12-20T21:15:22-05:00 packaging: Fix upload_ghc_libs.py script This change reflects the changes where .cabal files are now generated by hadrian rather than ./configure. Fixes #22518 - - - - - 7c6de18d by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Drop uses of AC_PROG_CC_C99 As noted in #22566, this macro is deprecated as of autoconf-2.70 `AC_PROG_CC` now sets `ac_cv_prog_cc_c99` itself. Closes #22566. - - - - - 36c5d98e by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Use AS_HELP_STRING instead of AC_HELP_STRING The latter has been deprecated. See #22566. - - - - - befe6ff8 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: fix various usages of head and tail - - - - - 666d0ba7 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: avoid head and tail in parseCallEscape and around - - - - - 5d96fd50 by Bodigrim at 2022-12-20T21:16:37-05:00 Make GHC.Driver.Main.hscTcRnLookupRdrName to return NonEmpty - - - - - 3ce2ab94 by Bodigrim at 2022-12-21T06:17:56-05:00 Allow transformers-0.6 in ghc, ghci, ghc-bin and hadrian - - - - - 954de93a by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule haskeline to HEAD (to allow transformers-0.6) - - - - - cefbeec3 by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule transformers to 0.6.0.4 - - - - - b4730b62 by Bodigrim at 2022-12-21T06:17:56-05:00 Fix tests T13253 imports MonadTrans, which acquired a quantified constraint in transformers-0.6, thus increase in allocations Metric Increase: T13253 - - - - - 0be75261 by Simon Peyton Jones at 2022-12-21T06:18:32-05:00 Abstract over the right free vars Fix #22459, in two ways: (1) Make the Specialiser not create a bogus specialisation if it is presented by strangely polymorphic dictionary. See Note [Weird special case in SpecDict] in GHC.Core.Opt.Specialise (2) Be more careful in abstractFloats See Note [Which type variables to abstract over] in GHC.Core.Opt.Simplify.Utils. So (2) stops creating the excessively polymorphic dictionary in abstractFloats, while (1) stops crashing if some other pass should nevertheless create a weirdly polymorphic dictionary. - - - - - df7bc6b3 by Ying-Ruei Liang (TheKK) at 2022-12-21T14:31:54-05:00 rts: explicitly store return value of ccall checkClosure to prevent type error (#22617) - - - - - e193e537 by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. - - - - - 3d55d8ab by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 - - - - - ceb2e9b9 by Ben Gamari at 2022-12-21T15:26:08-05:00 configure: Bump version to 9.6 - - - - - fb4d36c4 by Ben Gamari at 2022-12-21T15:27:49-05:00 base: Bump version to 4.18 Requires various submodule bumps. - - - - - 93ee7e90 by Ben Gamari at 2022-12-21T15:27:49-05:00 ghc-boot: Fix bootstrapping - - - - - fc3a2232 by Ben Gamari at 2022-12-22T13:45:06-05:00 Bump GHC version to 9.7 - - - - - 914f7fe3 by Andreas Klebinger at 2022-12-22T23:36:10-05:00 Don't consider large byte arrays/compact regions pinned. Workaround for #22255 which showed how treating large/compact regions as pinned could cause segfaults. - - - - - 32b32d7f by Matthew Pickering at 2022-12-22T23:36:46-05:00 hadrian bindist: Install manpages to share/man/man1/ghc.1 When the installation makefile was copied over the manpages were no longer installed in the correct place. Now we install it into share/man/man1/ghc.1 as the make build system did. Fixes #22371 - - - - - b3ddf803 by Ben Gamari at 2022-12-22T23:37:23-05:00 rts: Drop paths from configure from cabal file A long time ago we would rely on substitutions from the configure script to inject paths of the include and library directories of libffi and libdw. However, now these are instead handled inside Hadrian when calling Cabal's `configure` (see the uses of `cabalExtraDirs` in Hadrian's `Settings.Packages.packageArgs`). While the occurrences in the cabal file were redundant, they did no harm. However, since b5c714545abc5f75a1ffdcc39b4bfdc7cd5e64b4 they have no longer been interpolated. @mpickering noticed the suspicious uninterpolated occurrence of `@FFIIncludeDir@` in #22595, prompting this commit to finally remove them. - - - - - b2c7523d by Ben Gamari at 2022-12-22T23:37:59-05:00 Bump libffi-tarballs submodule We will now use libffi-3.4.4. - - - - - 3699a554 by Alan Zimmerman at 2022-12-22T23:38:35-05:00 EPA: Make EOF position part of AnnsModule Closes #20951 Closes #19697 - - - - - 99757ce8 by Sylvain Henry at 2022-12-22T23:39:13-05:00 JS: fix support for -outputdir (#22641) The `-outputdir` option wasn't correctly handled with the JS backend because the same code path was used to handle both objects produced by the JS backend and foreign .js files. Now we clearly distinguish the two in the pipeline, fixing the bug. - - - - - 02ed7d78 by Simon Peyton Jones at 2022-12-22T23:39:49-05:00 Refactor mkRuntimeError This patch fixes #22634. Because we don't have TYPE/CONSTRAINT polymorphism, we need two error functions rather than one. I took the opportunity to rname runtimeError to impossibleError, to line up with mkImpossibleExpr, and avoid confusion with the genuine runtime-error-constructing functions. - - - - - 35267f07 by Ben Gamari at 2022-12-22T23:40:32-05:00 base: Fix event manager shutdown race on non-Linux platforms During shutdown it's possible that we will attempt to use a closed fd to wakeup another capability's event manager. On the Linux eventfd path we were careful to handle this. However on the non-Linux path we failed to do so. Fix this. - - - - - 317f45c1 by Simon Peyton Jones at 2022-12-22T23:41:07-05:00 Fix unifier bug: failing to decompose over-saturated type family This simple patch fixes #22647 - - - - - 14b2e3d3 by Ben Gamari at 2022-12-22T23:41:42-05:00 rts/m32: Fix sanity checking Previously we would attempt to clear pages which were marked as read-only. Fix this. - - - - - 16a1bcd1 by Matthew Pickering at 2022-12-23T09:15:24+00:00 ci: Move wasm pipelines into nightly rather than master See #22664 for the changes which need to be made to bring one of these back to the validate pipeline. - - - - - 18d2acd2 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in marking of blackholes We must use an acquire-fence when marking to ensure that the indirectee is visible. - - - - - 11241efa by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix segment list races - - - - - 602455c9 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Use atomic when looking at bd->gen Since it may have been mutated by a moving GC. - - - - - 9d63b160 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Eliminate race in bump_static_flag To ensure that we don't race with a mutator entering a new CAF we take the SM mutex before touching static_flag. The other option here would be to instead modify newCAF to use a CAS but the present approach is a bit safer. - - - - - 26837523 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that mutable fields have acquire barrier - - - - - 8093264a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix races in collector status tracking Mark a number of accesses to do with tracking of the status of the concurrent collection thread as atomic. No interesting races here, merely necessary to satisfy TSAN. - - - - - 387d4fcc by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make segment state updates atomic - - - - - 543cae00 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Refactor update remembered set initialization This avoids a lock inversion between the storage manager mutex and the stable pointer table mutex by not dropping the SM_MUTEX in nonmovingCollect. This requires quite a bit of rejiggering but it does seem like a better strategy. - - - - - c9936718 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that we aren't holding locks when closing them TSAN complains about this sort of thing. - - - - - 0cd31f7d by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make bitmap accesses atomic This is a benign race on any sensible hard since these are byte accesses. Nevertheless, atomic accesses are necessary to satisfy TSAN. - - - - - d3fe110a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix benign race in update remembered set check Relaxed load is fine here since we will take the lock before looking at the list. - - - - - ab6cf893 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in shortcutting We must use an acquire load to read the info table pointer since if we find an indirection we must be certain that we see the indirectee. - - - - - 36c9f23c by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make free list counter accesses atomic Since these may race with the allocator(s). - - - - - aebef31c by doyougnu at 2022-12-23T19:10:09-05:00 add GHC.Utils.Binary.foldGet' and use for Iface A minor optimization to remove lazy IO and a lazy accumulator strictify foldGet' IFace.Binary: use strict foldGet' remove superfluous bang - - - - - 5eb357d9 by Ben Gamari at 2022-12-24T00:41:05-05:00 compiler: Ensure that GHC toolchain is first in search path As noted in #22561, it is important that GHC's toolchain look first for its own headers and libraries to ensure that the system's are not found instead. If this happens things can break in surprising ways (e.g. see #22561). - - - - - cbaebfb9 by Matthew Pickering at 2022-12-24T00:41:40-05:00 head.hackage: Use slow-validate bindist for linting jobs This enables the SLOW_VALIDATE env var for the linting head.hackage jobs, namely the jobs enabled manually, by the label or on the nightly build now use the deb10-numa-slow-validate bindist which has assertions enabled. See #22623 for a ticket which was found by using this configuration already! The head.hackage jobs triggered by upstream CI are now thusly: hackage-lint: Can be triggered on any MR, normal validate pipeline or nightly build. Runs head.hackage with -dlint and a slow-validate bindist hackage-label-lint: Trigged on MRs with "user-facing" label, runs the slow-validate head.hackage build with -dlint. nightly-hackage-lint: Runs automatically on nightly pipelines with slow-validate + dlint config. nightly-hackage-perf: Runs automaticaly on nightly pipelines with release build and eventlogging enabled. release-hackage-lint: Runs automatically on release pipelines with -dlint on a release bindist. - - - - - f4850f36 by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Don't run abi-test-nightly on release jobs The test is not configured to get the correct dependencies for the release pipelines (and indeed stops the release pipeline being run at all) - - - - - c264b06b by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Run head.hackage jobs on upstream-testing branch rather than master This change allows less priviledged users to trigger head.hackage jobs because less permissions are needed to trigger jobs on the upstream-testing branch, which is not protected. There is a CI job which updates upstream-testing each hour to the state of the master branch so it should always be relatively up-to-date. - - - - - 63b97430 by Ben Gamari at 2022-12-24T00:42:16-05:00 llvmGen: Fix relaxed ordering Previously I used LLVM's `unordered` ordering for the C11 `relaxed` ordering. However, this is wrong and should rather use the LLVM `monotonic` ordering. Fixes #22640 - - - - - f42ba88f by Ben Gamari at 2022-12-24T00:42:16-05:00 gitlab-ci: Introduce aarch64-linux-llvm job This nightly job will ensure that we don't break the LLVM backend on AArch64/Linux by bootstrapping GHC. This would have caught #22640. - - - - - 6d62f6bf by Matthew Pickering at 2022-12-24T00:42:51-05:00 Store RdrName rather than OccName in Holes In #20472 it was pointed out that you couldn't defer out of scope but the implementation collapsed a RdrName into an OccName to stuff it into a Hole. This leads to the error message for a deferred qualified name dropping the qualification which affects the quality of the error message. This commit adds a bit more structure to a hole, so a hole can replace a RdrName without losing information about what that RdrName was. This is important when printing error messages. I also added a test which checks the Template Haskell deferral of out of scope qualified names works properly. Fixes #22130 - - - - - 3c3060e4 by Richard Eisenberg at 2022-12-24T17:34:19+00:00 Drop support for kind constraints. This implements proposal 547 and closes ticket #22298. See the proposal and ticket for motivation. Compiler perf improves a bit Metrics: compile_time/bytes allocated ------------------------------------- CoOpt_Singletons(normal) -2.4% GOOD T12545(normal) +1.0% T13035(normal) -13.5% GOOD T18478(normal) +0.9% T9872d(normal) -2.2% GOOD geo. mean -0.2% minimum -13.5% maximum +1.0% Metric Decrease: CoOpt_Singletons T13035 T9872d - - - - - 6d7d4393 by Ben Gamari at 2022-12-24T21:09:56-05:00 hadrian: Ensure that linker scripts are used when merging objects In #22527 @rui314 inadvertantly pointed out a glaring bug in Hadrian's implementation of the object merging rules: unlike the old `make` build system we utterly failed to pass the needed linker scripts. Fix this. - - - - - a5bd0eb8 by Bodigrim at 2022-12-24T21:10:34-05:00 Document infelicities of instance Ord Double and workarounds - - - - - 62b9a7b2 by Zubin Duggal at 2023-01-03T12:22:11+00:00 Force the Docs structure to prevent leaks in GHCi with -haddock without -fwrite-interface Involves adding many new NFData instances. Without forcing Docs, references to the TcGblEnv for each module are retained by the Docs structure. Usually these are forced when the ModIface is serialised but not when we aren't writing the interface. - - - - - 21bedd84 by Facundo Domínguez at 2023-01-03T23:27:30-05:00 Explain the auxiliary functions of permutations - - - - - 32255d05 by Matthew Pickering at 2023-01-04T11:58:42+00:00 compiler: Add -f[no-]split-sections flags Here we add a `-fsplit-sections` flag which may some day replace `-split-sections`. This has the advantage of automatically providing a `-fno-split-sections` flag, which is useful for our packaging because we enable `-split-sections` by default but want to disable it in certain configurations. - - - - - e640940c by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Fix computation of tables_next_to_code for outOfTreeCompiler This copy-pasto was introduced in de5fb3489f2a9bd6dc75d0cb8925a27fe9b9084b - - - - - 15bee123 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add test:all_deps to build just testsuite dependencies Fixes #22534 - - - - - fec6638e by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add no_split_sections tranformer This transformer reverts the effect of `split_sections`, which we intend to use for platforms which don't support split sections. In order to achieve this we have to modify the implemntation of the split_sections transformer to store whether we are enabling split_sections directly in the `Flavour` definition. This is because otherwise there's no convenient way to turn off split_sections due to having to pass additional linker scripts when merging objects. - - - - - 3dc05726 by Matthew Pickering at 2023-01-04T11:58:42+00:00 check-exact: Fix build with -Werror - - - - - 53a6ae7a by Matthew Pickering at 2023-01-04T11:58:42+00:00 ci: Build all test dependencies with in-tree compiler This means that these executables will honour flavour transformers such as "werror". Fixes #22555 - - - - - 32e264c1 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Document using GHC environment variable to select boot compiler Fixes #22340 - - - - - be9dd9b0 by Matthew Pickering at 2023-01-04T11:58:42+00:00 packaging: Build perf builds with -split-sections In 8f71d958 the make build system was made to use split-sections on linux systems but it appears this logic never made it to hadrian. There is the split_sections flavour transformer but this doesn't appear to be used for perf builds on linux. This is disbled on deb9 and windows due to #21670 Closes #21135 - - - - - 00dc5106 by Matthew Pickering at 2023-01-04T14:32:45-05:00 sphinx: Use modern syntax for extlinks This fixes the following build error: ``` Command line: /opt/homebrew/opt/sphinx-doc/bin/sphinx-build -b man -d /private/tmp/extra-dir-55768274273/.doctrees-man -n -w /private/tmp/extra-dir-55768274273/.log docs/users_guide /private/tmp/extra-dir-55768274273 ===> Command failed with error code: 2 Exception occurred: File "/opt/homebrew/Cellar/sphinx-doc/6.0.0/libexec/lib/python3.11/site-packages/sphinx/ext/extlinks.py", line 101, in role title = caption % part ~~~~~~~~^~~~~~ TypeError: not all arguments converted during string formatting ``` I tested on Sphinx-5.1.1 and Sphinx-6.0.0 Thanks for sterni for providing instructions about how to test using sphinx-6.0.0. Fixes #22690 - - - - - 541aedcd by Krzysztof Gogolewski at 2023-01-05T10:48:34-05:00 Misc cleanup - Remove unused uniques and hs-boot declarations - Fix types of seq and unsafeCoerce# - Remove FastString/String roundtrip in JS - Use TTG to enforce totality - Remove enumeration in Heap/Inspect; the 'otherwise' clause serves the primitive types well. - - - - - 22bb8998 by Alan Zimmerman at 2023-01-05T10:49:09-05:00 EPA: Do not collect comments from end of file In Parser.y semis1 production triggers for the virtual semi at the end of the file. This is detected by it being zero length. In this case, do not extend the span being used to gather comments, so any final comments are allocated at the module level instead. - - - - - 9e077999 by Vladislav Zavialov at 2023-01-05T23:01:55-05:00 HsToken in TypeArg (#19623) Updates the haddock submodule. - - - - - b2a2db04 by Matthew Pickering at 2023-01-05T23:02:30-05:00 Revert "configure: Drop uses of AC_PROG_CC_C99" This reverts commit 7c6de18dd3151ead954c210336728e8686c91de6. Centos7 using a very old version of the toolchain (autotools-2.69) where the behaviour of these macros has not yet changed. I am reverting this without haste as it is blocking the 9.6 branch. Fixes #22704 - - - - - 28f8c0eb by Luite Stegeman at 2023-01-06T18:16:24+09:00 Add support for sized literals in the bytecode interpreter. The bytecode interpreter only has branching instructions for word-sized values. These are used for pattern matching. Branching instructions for other types (e.g. Int16# or Word8#) weren't needed, since unoptimized Core or STG never requires branching on types like this. It's now possible for optimized STG to reach the bytecode generator (e.g. fat interface files or certain compiler flag combinations), which requires dealing with various sized literals in branches. This patch improves support for generating bytecode from optimized STG by adding the following new bytecode instructions: TESTLT_I64 TESTEQ_I64 TESTLT_I32 TESTEQ_I32 TESTLT_I16 TESTEQ_I16 TESTLT_I8 TESTEQ_I8 TESTLT_W64 TESTEQ_W64 TESTLT_W32 TESTEQ_W32 TESTLT_W16 TESTEQ_W16 TESTLT_W8 TESTEQ_W8 Fixes #21945 - - - - - ac39e8e9 by Matthew Pickering at 2023-01-06T13:47:00-05:00 Only store Name in FunRhs rather than Id with knot-tied fields All the issues here have been caused by #18758. The goal of the ticket is to be able to talk about things like `LTyClDecl GhcTc`. In the case of HsMatchContext, the correct "context" is whatever we want, and in fact storing just a `Name` is sufficient and correct context, even if the rest of the AST is storing typechecker Ids. So this reverts (#20415, !5579) which intended to get closed to #18758 but didn't really and introduced a few subtle bugs. Printing of an error message in #22695 would just hang, because we would attempt to print the `Id` in debug mode to assertain whether it was empty or not. Printing the Name is fine for the error message. Another consequence is that when `-dppr-debug` was enabled the compiler would hang because the debug printing of the Id would try and print fields which were not populated yet. This also led to 32070e6c2e1b4b7c32530a9566fe14543791f9a6 having to add a workaround for the `checkArgs` function which was probably a very similar bug to #22695. Fixes #22695 - - - - - c306d939 by Matthew Pickering at 2023-01-06T22:08:53-05:00 ci: Upgrade darwin, windows and freebsd CI to use GHC-9.4.3 Fixes #22599 - - - - - 0db496ff by Matthew Pickering at 2023-01-06T22:08:53-05:00 darwin ci: Explicitly pass desired build triple to configure On the zw3rk machines for some reason the build machine was inferred to be arm64. Setting the build triple appropiately resolve this confusion and we produce x86 binaries. - - - - - 2459c358 by Ben Gamari at 2023-01-06T22:09:29-05:00 rts: MUT_VAR is not a StgMutArrPtrs There was previously a comment claiming that the MUT_VAR closure type had the layout of StgMutArrPtrs. - - - - - 6206cb92 by Simon Peyton Jones at 2023-01-07T12:14:40-05:00 Make FloatIn robust to shadowing This MR fixes #22622. See the new Note [Shadowing and name capture] I did a bit of refactoring in sepBindsByDropPoint too. The bug doesn't manifest in HEAD, but it did show up in 9.4, so we should backport this patch to 9.4 - - - - - a960ca81 by Matthew Pickering at 2023-01-07T12:15:15-05:00 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s - - - - - 73484710 by Matthew Pickering at 2023-01-07T12:15:15-05:00 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. - - - - - 8c0ea25f by Matthew Pickering at 2023-01-07T12:15:15-05:00 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes - - - - - 365b3045 by Matthew Pickering at 2023-01-09T02:36:20-05:00 Disable split sections on aarch64-deb10 build See #22722 Failure on this job: https://gitlab.haskell.org/ghc/ghc/-/jobs/1287852 ``` Unexpected failures: /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T10828.run T10828 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T13123.run T13123 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T20590.run T20590 [exit code non-0] (ext-interp) Appending 232 stats to file: /builds/ghc/ghc/performance-metrics.tsv ``` ``` Compile failed (exit code 1) errors were: data family D_0 a_1 :: * -> * data instance D_0 GHC.Types.Int GHC.Types.Bool :: * where DInt_2 :: D_0 GHC.Types.Int GHC.Types.Bool data E_3 where MkE_4 :: a_5 -> E_3 data Foo_6 a_7 b_8 where MkFoo_9, MkFoo'_10 :: a_11 -> Foo_6 a_11 b_12 newtype Bar_13 :: * -> GHC.Types.Bool -> * where MkBar_14 :: a_15 -> Bar_13 a_15 b_16 data T10828.T (a_0 :: *) where T10828.MkT :: forall (a_1 :: *) . a_1 -> a_1 -> T10828.T a_1 T10828.MkC :: forall (a_2 :: *) (b_3 :: *) . (GHC.Types.~) a_2 GHC.Types.Int => {T10828.foo :: a_2, T10828.bar :: b_3} -> T10828.T GHC.Types.Int T10828.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: (do TyConI dec <- runQ $ reify (mkName "T") runIO $ putStrLn (pprint dec) >> hFlush stdout d <- runQ $ [d| data T' a :: Type where MkT' :: a -> a -> T' a MkC' :: forall a b. (a ~ Int) => {foo :: a, bar :: b} -> T' Int |] runIO $ putStrLn (pprint d) >> hFlush stdout ....) *** unexpected failure for T10828(ext-interp) =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] Compile failed (exit code 1) errors were: T13123.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data GADT where MkGADT :: forall k proxy (a :: k). proxy a -> GADT |]) *** unexpected failure for T13123(ext-interp) =====> 7100 of 9215 [0, 2, 0] =====> 7100 of 9215 [0, 2, 0] =====> 7200 of 9215 [0, 2, 0] Compile failed (exit code 1) errors were: T20590.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data T where MkT :: forall a. a -> T |]) *** unexpected failure for T20590(ext-interp) ``` Looks fairly worrying to me. - - - - - 965a2735 by Alan Zimmerman at 2023-01-09T02:36:20-05:00 EPA: exact print HsDocTy To match ghc-exactprint https://github.com/alanz/ghc-exactprint/pull/121 - - - - - 5d65773e by John Ericson at 2023-01-09T20:39:27-05:00 Remove RTS hack for configuring See the brand new Note [Undefined symbols in the RTS] for additional details. - - - - - e3fff751 by Sebastian Graf at 2023-01-09T20:40:02-05:00 Handle shadowing in DmdAnal (#22718) Previously, when we had a shadowing situation like ```hs f x = ... -- demand signature <1L><1L> main = ... \f -> f 1 ... ``` we'd happily use the shadowed demand signature at the call site inside the lambda. Of course, that's wrong and solution is simply to remove the demand signature from the `AnalEnv` when we enter the lambda. This patch does so for all binding constructs Core. In #22718 the issue was caused by LetUp not shadowing away the existing demand signature for the let binder in the let body. The resulting absent error is fickle to reproduce; hence no reproduction test case. #17478 would help. Fixes #22718. It appears that TcPlugin_Rewrite regresses by ~40% on Darwin. It is likely that DmdAnal was exploiting ill-scoped analysis results. Metric increase ['bytes allocated'] (test_env=x86_64-darwin-validate): TcPlugin_Rewrite - - - - - d53f6f4d by Oleg Grenrus at 2023-01-09T21:11:02-05:00 Add safe list indexing operator: !? With Joachim's amendments. Implements https://github.com/haskell/core-libraries-committee/issues/110 - - - - - cfaf1ad7 by Nicolas Trangez at 2023-01-09T21:11:03-05:00 rts, tests: limit thread name length to 15 bytes On Linux, `pthread_setname_np` (or rather, the kernel) only allows for thread names up to 16 bytes, including the terminating null byte. This commit adds a note pointing this out in `createOSThread`, and fixes up two instances where a thread name of more than 15 characters long was used (in the RTS, and in a test-case). Fixes: #22366 Fixes: https://gitlab.haskell.org/ghc/ghc/-/issues/22366 See: https://gitlab.haskell.org/ghc/ghc/-/issues/22366#note_460796 - - - - - 64286132 by Matthew Pickering at 2023-01-09T21:11:03-05:00 Store bootstrap_llvm_target and use it to set LlvmTarget in bindists This mirrors some existing logic for the bootstrap_target which influences how TargetPlatform is set. As described on #21970 not storing this led to `LlvmTarget` being set incorrectly and hence the wrong `--target` flag being passed to the C compiler. Towards #21970 - - - - - 4724e8d1 by Matthew Pickering at 2023-01-09T21:11:04-05:00 Check for FP_LD_NO_FIXUP_CHAINS in installation configure script Otherwise, when installing from a bindist the C flag isn't passed to the C compiler. This completes the fix for #22429 - - - - - 2e926b88 by Georgi Lyubenov at 2023-01-09T21:11:07-05:00 Fix outdated link to Happy section on sequences - - - - - 146a1458 by Matthew Pickering at 2023-01-09T21:11:07-05:00 Revert "NCG(x86): Compile add+shift as lea if possible." This reverts commit 20457d775885d6c3df020d204da9a7acfb3c2e5a. See #22666 and #21777 - - - - - 6e6adbe3 by Jade Lovelace at 2023-01-11T00:55:30-05:00 Fix tcPluginRewrite example - - - - - faa57138 by Jade Lovelace at 2023-01-11T00:55:31-05:00 fix missing haddock pipe - - - - - 0470ea7c by Florian Weimer at 2023-01-11T00:56:10-05:00 m4/fp_leading_underscore.m4: Avoid implicit exit function declaration And switch to a new-style function definition. Fixes build issues with compilers that do not accept implicit function declarations. - - - - - b2857df4 by HaskellMouse at 2023-01-11T00:56:52-05:00 Added a new warning about compatibility with RequiredTypeArguments This commit introduces a new warning that indicates code incompatible with future extension: RequiredTypeArguments. Enabling this extension may break some code and the warning will help to make it compatible in advance. - - - - - 5f17e21a by Ben Gamari at 2023-01-11T00:57:27-05:00 testsuite: Drop testheapalloced.c As noted in #22414, this file (which appears to be a benchmark for characterising the one-step allocator's MBlock cache) is currently unreferenced. Remove it. Closes #22414. - - - - - bc125775 by Vladislav Zavialov at 2023-01-11T00:58:03-05:00 Introduce the TypeAbstractions language flag GHC Proposals #448 "Modern scoped type variables" and #425 "Invisible binders in type declarations" introduce a new language extension flag: TypeAbstractions. Part of the functionality guarded by this flag has already been implemented, namely type abstractions in constructor patterns, but it was guarded by a combination of TypeApplications and ScopedTypeVariables instead of a dedicated language extension flag. This patch does the following: * introduces a new language extension flag TypeAbstractions * requires TypeAbstractions for @a-syntax in constructor patterns instead of TypeApplications and ScopedTypeVariables * creates a User's Guide page for TypeAbstractions and moves the "Type Applications in Patterns" section there To avoid a breaking change, the new flag is implied by ScopedTypeVariables and is retroactively added to GHC2021. Metric Decrease: MultiLayerModulesTH_OneShot - - - - - 083f7015 by Krzysztof Gogolewski at 2023-01-11T00:58:38-05:00 Misc cleanup - Remove unused mkWildEvBinder - Use typeTypeOrConstraint - more symmetric and asserts that that the type is Type or Constraint - Fix escape sequences in Python; they raise a deprecation warning with -Wdefault - - - - - aed1974e by Richard Eisenberg at 2023-01-11T08:30:42+00:00 Refactor the treatment of loopy superclass dicts This patch completely re-engineers how we deal with loopy superclass dictionaries in instance declarations. It fixes #20666 and #19690 The highlights are * Recognise that the loopy-superclass business should use precisely the Paterson conditions. This is much much nicer. See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance * With that in mind, define "Paterson-smaller" in Note [Paterson conditions] in GHC.Tc.Validity, and the new data type `PatersonSize` in GHC.Tc.Utils.TcType, along with functions to compute and compare PatsonSizes * Use the new PatersonSize stuff when solving superclass constraints See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance * In GHC.Tc.Solver.Monad.lookupInInerts, add a missing call to prohibitedSuperClassSolve. This was the original cause of #20666. * Treat (TypeError "stuff") as having PatersonSize zero. See Note [Paterson size for type family applications] in GHC.Tc.Utils.TcType. * Treat the head of a Wanted quantified constraint in the same way as the superclass of an instance decl; this is what fixes #19690. See GHC.Tc.Solver.Canonical Note [Solving a Wanted forall-constraint] (Thanks to Matthew Craven for this insight.) This entailed refactoring the GivenSc constructor of CtOrigin a bit, to say whether it comes from an instance decl or quantified constraint. * Some refactoring way in which redundant constraints are reported; we don't want to complain about the extra, apparently-redundant constraints that we must add to an instance decl because of the loopy-superclass thing. I moved some work from GHC.Tc.Errors to GHC.Tc.Solver. * Add a new section to the user manual to describe the loopy superclass issue and what rules it follows. - - - - - 300bcc15 by HaskellMouse at 2023-01-11T13:43:36-05:00 Parse qualified terms in type signatures This commit allows qualified terms in type signatures to pass the parser and to be cathced by renamer with more informative error message. Adds a few tests. Fixes #21605 - - - - - 964284fc by Simon Peyton Jones at 2023-01-11T13:44:12-05:00 Fix void-arg-adding mechanism for worker/wrapper As #22725 shows, in worker/wrapper we must add the void argument /last/, not first. See GHC.Core.Opt.WorkWrap.Utils Note [Worker/wrapper needs to add void arg last]. That led me to to study GHC.Core.Opt.SpecConstr Note [SpecConstr needs to add void args first] which suggests the opposite! And indeed I think it's the other way round for SpecConstr -- or more precisely the void arg must precede the "extra_bndrs". That led me to some refactoring of GHC.Core.Opt.SpecConstr.calcSpecInfo. - - - - - f7ceafc9 by Krzysztof Gogolewski at 2023-01-11T22:36:59-05:00 Add 'docWithStyle' to improve codegen This new combinator docWithStyle :: IsOutput doc => doc -> (PprStyle -> SDoc) -> doc let us remove the need for code to be polymorphic in HDoc when not used in code style. Metric Decrease: ManyConstructors T13035 T1969 - - - - - b3be0d18 by Simon Peyton Jones at 2023-01-11T22:37:35-05:00 Fix finaliseArgBoxities for OPAQUE function We never do worker wrapper for OPAQUE functions, so we must zap the unboxing info during strictness analysis. This patch fixes #22502 - - - - - db11f358 by Ben Gamari at 2023-01-12T07:49:04-05:00 Revert "rts: Drop racy assertion" The logic here was inverted. Reverting the commit to avoid confusion when examining the commit history. This reverts commit b3eacd64fb36724ed6c5d2d24a81211a161abef1. - - - - - 3242139f by Ben Gamari at 2023-01-12T07:49:04-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 9ffd5d57 by Ben Gamari at 2023-01-12T07:49:41-05:00 configure: Fix escaping of `$tooldir` In !9547 I introduced `$tooldir` directories into GHC's default link and compilation flags to ensure that our C toolchain finds its own headers and libraries before others on the system. However, the patch was subtly wrong in the escaping of `$tooldir`. Fix this. Fixes #22561. - - - - - 905d0b6e by Sebastian Graf at 2023-01-12T15:51:47-05:00 Fix contification with stable unfoldings (#22428) Many functions now return a `TailUsageDetails` that adorns a `UsageDetails` with a `JoinArity` that reflects the number of join point binders around the body for which the `UsageDetails` was computed. `TailUsageDetails` is now returned by `occAnalLamTail` as well as `occAnalUnfolding` and `occAnalRules`. I adjusted `Note [Join points and unfoldings/rules]` and `Note [Adjusting right-hand sides]` to account for the new machinery. I also wrote a new `Note [Join arity prediction based on joinRhsArity]` and refer to it when we combine `TailUsageDetails` for a recursive RHS. I also renamed * `occAnalLam` to `occAnalLamTail` * `adjustRhsUsage` to `adjustTailUsage` * a few other less important functions and properly documented the that each call of `occAnalLamTail` must pair up with `adjustTailUsage`. I removed `Note [Unfoldings and join points]` because it was redundant with `Note [Occurrences in stable unfoldings]`. While in town, I refactored `mkLoopBreakerNodes` so that it returns a condensed `NodeDetails` called `SimpleNodeDetails`. Fixes #22428. The refactoring seems to have quite beneficial effect on ghc/alloc performance: ``` CoOpt_Read(normal) ghc/alloc 784,778,420 768,091,176 -2.1% GOOD T12150(optasm) ghc/alloc 77,762,270 75,986,720 -2.3% GOOD T12425(optasm) ghc/alloc 85,740,186 84,641,712 -1.3% GOOD T13056(optasm) ghc/alloc 306,104,656 299,811,632 -2.1% GOOD T13253(normal) ghc/alloc 350,233,952 346,004,008 -1.2% T14683(normal) ghc/alloc 2,800,514,792 2,754,651,360 -1.6% T15304(normal) ghc/alloc 1,230,883,318 1,215,978,336 -1.2% T15630(normal) ghc/alloc 153,379,590 151,796,488 -1.0% T16577(normal) ghc/alloc 7,356,797,056 7,244,194,416 -1.5% T17516(normal) ghc/alloc 1,718,941,448 1,692,157,288 -1.6% T19695(normal) ghc/alloc 1,485,794,632 1,458,022,112 -1.9% T21839c(normal) ghc/alloc 437,562,314 431,295,896 -1.4% GOOD T21839r(normal) ghc/alloc 446,927,580 440,615,776 -1.4% GOOD geo. mean -0.6% minimum -2.4% maximum -0.0% ``` Metric Decrease: CoOpt_Read T10421 T12150 T12425 T13056 T18698a T18698b T21839c T21839r T9961 - - - - - a1491c87 by Andreas Klebinger at 2023-01-12T15:52:23-05:00 Only gc sparks locally when we can ensure marking is done. When performing GC without work stealing there was no guarantee that spark pruning was happening after marking of the sparks. This could cause us to GC live sparks under certain circumstances. Fixes #22528. - - - - - 8acfe930 by Cheng Shao at 2023-01-12T15:53:00-05:00 Change MSYSTEM to CLANG64 uniformly - - - - - 73bc162b by M Farkas-Dyck at 2023-01-12T15:53:42-05:00 Make `GHC.Tc.Errors.Reporter` take `NonEmpty ErrorItem` rather than `[ErrorItem]`, which lets us drop some panics. Also use the `BasicMismatch` constructor rather than `mkBasicMismatchMsg`, which lets us drop the "-Wno-incomplete-record-updates" flag. - - - - - 1b812b69 by Oleg Grenrus at 2023-01-12T15:54:21-05:00 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general - - - - - c79b2b65 by Matthew Pickering at 2023-01-12T15:54:58-05:00 Don't run hadrian-multi on fast-ci label Fixes #22667 - - - - - 9a3d6add by Bodigrim at 2023-01-13T00:46:36-05:00 Bump submodule bytestring to 0.11.4.0 Metric Decrease: T21839c T21839r - - - - - df33c13c by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Bump Darwin bootstrap toolchain This updates the bootstrap compiler on Darwin from 8.10.7 to 9.2.5, ensuring that we have the fix for #21964. - - - - - 756a66ec by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Pass -w to cabal update Due to cabal#8447, cabal-install 3.8.1.0 requires a compiler to run `cabal update`. - - - - - 1142f858 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump hsc2hs submodule - - - - - d4686729 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump process submodule - - - - - 84ae6573 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: Bump DOCKER_REV - - - - - d53598c5 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: enable xz parallel compression for x64 jobs - - - - - d31fcbca by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: use in-image emsdk for js jobs - - - - - 93b9bbc1 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: improve nix-shell for gen_ci.hs and fix some ghc/hlint warnings - Add a ghc environment including prebuilt dependencies to the nix-shell. Get rid of the ad hoc cabal cache and all dependencies are now downloaded from the nixos binary cache. - Make gen_ci.hs a cabal package with HLS integration, to make future hacking of gen_ci.hs easier. - Fix some ghc/hlint warnings after I got HLS to work. - For the lint-ci-config job, do a shallow clone to save a few minutes of unnecessary git checkout time. - - - - - 8acc56c7 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: source the toolchain env file in wasm jobs - - - - - 87194df0 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: add wasm ci jobs via gen_ci.hs - There is one regular wasm job run in validate pipelines - Additionally, int-native/unreg wasm jobs run in nightly/release pipelines Also, remove the legacy handwritten wasm ci jobs in .gitlab-ci.yml. - - - - - b6eb9bcc by Matthew Pickering at 2023-01-13T11:52:16+00:00 wasm ci: Remove wasm release jobs This removes the wasm release jobs, as we do not yet intend to distribute these binaries. - - - - - 496607fd by Simon Peyton Jones at 2023-01-13T16:52:07-05:00 Add a missing checkEscapingKind Ticket #22743 pointed out that there is a missing check, for type-inferred bindings, that the inferred type doesn't have an escaping kind. The fix is easy. - - - - - 7a9a1042 by Andreas Klebinger at 2023-01-16T20:48:19-05:00 Separate core inlining logic from `Unfolding` type. This seems like a good idea either way, but is mostly motivated by a patch where this avoids a module loop. - - - - - 33b58f77 by sheaf at 2023-01-16T20:48:57-05:00 Hadrian: generalise &%> to avoid warnings This patch introduces a more general version of &%> that works with general traversable shapes, instead of lists. This allows us to pass along the information that the length of the list of filepaths passed to the function exactly matches the length of the input list of filepath patterns, avoiding pattern match warnings. Fixes #22430 - - - - - 8c7a991c by Andreas Klebinger at 2023-01-16T20:49:34-05:00 Add regression test for #22611. A case were a function used to fail to specialize, but now does. - - - - - 6abea760 by Andreas Klebinger at 2023-01-16T20:50:10-05:00 Mark maximumBy/minimumBy as INLINE. The RHS was too large to inline which often prevented the overhead of the Maybe from being optimized away. By marking it as INLINE we can eliminate the overhead of both the maybe and are able to unpack the accumulator when possible. Fixes #22609 - - - - - 99d151bb by Matthew Pickering at 2023-01-16T20:50:50-05:00 ci: Bump CACHE_REV so that ghc-9.6 branch and HEAD have different caches Having the same CACHE_REV on both branches leads to issues where the darwin toolchain is different on ghc-9.6 and HEAD which leads to long darwin build times. In general we should ensure that each branch has a different CACHE_REV. - - - - - 6a5845fb by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in source-tarball job This fixes errors of the form: ``` fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc inferred 9.7.20230113 checking for GHC Git commit id... fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc ``` - - - - - 4afb952c by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't build aarch64-deb10-llvm job on release pipelines Closes #22721 - - - - - 8039feb9 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in test-bootstrap job - - - - - 0b358d0c by Matthew Pickering at 2023-01-16T20:51:25-05:00 rel_eng: Add release engineering scripts into ghc tree It is better to keep these scripts in the tree as they depend on the CI configuration and so on. By keeping them in tree we can keep them up-to-date as the CI config changes and also makes it easier to backport changes to the release script between release branches in future. The final motivation is that it makes generating GHCUp metadata possible. - - - - - 28cb2ed0 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't use complicated image or clone in not-interruptible job This job exists only for the meta-reason of not allowing nightly pipelines to be cancelled. It was taking two minutes to run as in order to run "true" we would also clone the whole GHC repo. - - - - - eeea59bb by Matthew Pickering at 2023-01-16T20:51:26-05:00 Add scripts to generate ghcup metadata on nightly and release pipelines 1. A python script in .gitlab/rel_eng/mk-ghcup-metadata which generates suitable metadata for consumption by GHCUp for the relevant pipelines. - The script generates the metadata just as the ghcup maintainers want, without taking into account platform/library combinations. It is updated manually when the mapping changes. - The script downloads the bindists which ghcup wants to distribute, calculates the hash and generates the yaml in the correct structure. - The script is documented in the .gitlab/rel_eng/mk-ghcup-metadata/README.mk file 1a. The script requires us to understand the mapping from platform -> job. To choose the preferred bindist for each platform the .gitlab/gen_ci.hs script is modified to allow outputting a metadata file which answers the question about which job produces the bindist which we want to distribute to users for a specific platform. 2. Pipelines to run on nightly and release jobs to generate metadata - ghcup-metadata-nightly: Generates metadata which points directly to artifacts in the nightly job. - ghcup-metadata-release: Generates metadata suitable for inclusion directly in ghcup by pointing to the downloads folder where the bindist will be uploaded to. 2a. Trigger jobs which test the generated metadata in the downstream `ghccup-ci` repo. See that repo for documentation about what is tested and how but essentially we test in a variety of clean images that ghcup can download and install the bindists we say exist in our metadata. - - - - - 97bd4d8c by Bodigrim at 2023-01-16T20:52:04-05:00 Bump submodule parsec to 3.1.16.1 - - - - - 97ac8230 by Alan Zimmerman at 2023-01-16T20:52:39-05:00 EPA: Add annotation for 'type' in DataDecl Closes #22765 - - - - - dbbab95d by Ben Gamari at 2023-01-17T06:36:06-05:00 compiler: Small optimisation of assertM In #22739 @AndreasK noticed that assertM performed the action to compute the asserted predicate regardless of whether DEBUG is enabled. This is inconsistent with the other assertion operations and general convention. Fix this. Closes #22739. - - - - - fc02f3bb by Viktor Dukhovni at 2023-01-17T06:36:47-05:00 Avoid unnecessary printf warnings in EventLog.c Fixes #22778 - - - - - 003b6d44 by Simon Peyton Jones at 2023-01-17T16:33:05-05:00 Document the semantics of pattern bindings a bit better This MR is in response to the discussion on #22719 - - - - - f4d50baf by Vladislav Zavialov at 2023-01-17T16:33:41-05:00 Hadrian: fix warnings (#22783) This change fixes the following warnings when building Hadrian: src/Hadrian/Expression.hs:38:10: warning: [-Wredundant-constraints] src/Hadrian/Expression.hs:84:13: warning: [-Wtype-equality-requires-operators] src/Hadrian/Expression.hs:84:21: warning: [-Wtype-equality-requires-operators] src/Hadrian/Haskell/Cabal/Parse.hs:67:1: warning: [-Wunused-imports] - - - - - 06036d93 by Sylvain Henry at 2023-01-18T01:55:10-05:00 testsuite: req_smp --> req_target_smp, req_ghc_smp See #22630 and !9552 This commit: - splits req_smp into req_target_smp and req_ghc_smp - changes the testsuite driver to calculate req_ghc_smp - changes a handful of tests to use req_target_smp instead of req_smp - changes a handful of tests to use req_host_smp when needed The problem: - the problem this solves is the ambiguity surrounding req_smp - on master req_smp was used to express the constraint that the program being compiled supports smp _and_ that the host RTS (i.e., the RTS used to compile the program) supported smp. Normally that is fine, but in cross compilation this is not always the case as was discovered in #22630. The solution: - Differentiate the two constraints: - use req_target_smp to say the RTS the compiled program is linked with (and the platform) supports smp - use req_host_smp to say the RTS the host is linked with supports smp WIP: fix req_smp (target vs ghc) add flag to separate bootstrapper split req_smp -> req_target_smp and req_ghc_smp update tests smp flags cleanup and add some docstrings only set ghc_with_smp to bootstrapper on S1 or CC Only set ghc_with_smp to bootstrapperWithSMP of when testing stage 1 and cross compiling test the RTS in config/ghc not hadrian re-add ghc_with_smp fix and align req names fix T11760 to use req_host_smp test the rts directly, avoid python 3.5 limitation test the compiler in a try block align out of tree and in tree withSMP flags mark failing tests as host req smp testsuite: req_host_smp --> req_ghc_smp Fix ghc vs host, fix ghc_with_smp leftover - - - - - ee9b78aa by Krzysztof Gogolewski at 2023-01-18T01:55:45-05:00 Use -Wdefault when running Python testdriver (#22727) - - - - - e9c0537c by Vladislav Zavialov at 2023-01-18T01:56:22-05:00 Enable -Wstar-is-type by default (#22759) Following the plan in GHC Proposal #143 "Remove the * kind syntax", which states: In the next release (or 3 years in), enable -fwarn-star-is-type by default. The "next release" happens to be 9.6.1 I also moved the T21583 test case from should_fail to should_compile, because the only reason it was failing was -Werror=compat in our test suite configuration. - - - - - 4efee43d by Ryan Scott at 2023-01-18T01:56:59-05:00 Add missing parenthesizeHsType in cvtSigTypeKind We need to ensure that the output of `cvtSigTypeKind` is parenthesized (at precedence `sigPrec`) so that any type signatures with an outermost, explicit kind signature can parse correctly. Fixes #22784. - - - - - f891a442 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. - - - - - b13c6ea5 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. - - - - - c45a5fff by Cheng Shao at 2023-01-18T07:28:37-05:00 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. - - - - - b4c14c4b by Luite Stegeman at 2023-01-18T14:21:42-05:00 Add PrimCallConv support to GHCi This adds support for calling Cmm code from bytecode using the native calling convention, allowing modules that use `foreign import prim` to be loaded and debugged in GHCi. This patch introduces a new `PRIMCALL` bytecode instruction and a helper stack frame `stg_primcall`. The code is based on the existing functionality for dealing with unboxed tuples in bytecode, which has been generalised to handle arbitrary calls. Fixes #22051 - - - - - d0a63ef8 by Adam Gundry at 2023-01-18T14:22:26-05:00 Refactor warning flag parsing to add missing flags This adds `-Werror=<group>` and `-fwarn-<group>` flags for warning groups as well as individual warnings. Previously these were defined on an ad hoc basis so for example we had `-Werror=compat` but not `-Werror=unused-binds`, whereas we had `-fwarn-unused-binds` but not `-fwarn-compat`. Fixes #22182. - - - - - 7ed1b8ef by Adam Gundry at 2023-01-18T14:22:26-05:00 Minor corrections to comments - - - - - 5389681e by Adam Gundry at 2023-01-18T14:22:26-05:00 Revise warnings documentation in user's guide - - - - - ab0d5cda by Adam Gundry at 2023-01-18T14:22:26-05:00 Move documentation of deferred type error flags out of warnings section - - - - - eb5a6b91 by John Ericson at 2023-01-18T22:24:10-05:00 Give the RTS it's own configure script Currently it doesn't do much anything, we are just trying to introduce it without breaking the build. Later, we will move functionality from the top-level configure script over to it. We need to bump Cabal for https://github.com/haskell/cabal/pull/8649; to facilitate and existing hack of skipping some configure checks for the RTS we now need to skip just *part* not *all* of the "post configure" hook, as running the configure script (which we definitely want to do) is also implemented as part of the "post configure" hook. But doing this requires exposing functionality that wasn't exposed before. - - - - - 32ab07bf by Bodigrim at 2023-01-18T22:24:51-05:00 ghc package does not have to depend on terminfo - - - - - 981ff7c4 by Bodigrim at 2023-01-18T22:24:51-05:00 ghc-pkg does not have to depend on terminfo - - - - - f058e367 by Ben Gamari at 2023-01-18T22:25:27-05:00 nativeGen/X86: MFENCE is unnecessary for release semantics In #22764 a user noticed that a program implementing a simple atomic counter via an STRef regressed significantly due to the introduction of necessary atomic operations in the MutVar# primops (#22468). This regression was caused by a bug in the NCG, which emitted an unnecessary MFENCE instruction for a release-ordered atomic write. MFENCE is rather only needed to achieve sequentially consistent ordering. Fixes #22764. - - - - - 154889db by Ryan Scott at 2023-01-18T22:26:03-05:00 Add regression test for #22151 Issue #22151 was coincidentally fixed in commit aed1974e92366ab8e117734f308505684f70cddf (`Refactor the treatment of loopy superclass dicts`). This adds a regression test to ensure that the issue remains fixed. Fixes #22151. - - - - - 14b5982a by Andrei Borzenkov at 2023-01-18T22:26:43-05:00 Fix printing of promoted MkSolo datacon (#22785) Problem: In 2463df2f, the Solo data constructor was renamed to MkSolo, and Solo was turned into a pattern synonym for backwards compatibility. Since pattern synonyms can not be promoted, the old code that pretty-printed promoted single-element tuples started producing ill-typed code: t :: Proxy ('Solo Int) This fails with "Pattern synonym ‘Solo’ used as a type" The solution is to track the distinction between type constructors and data constructors more carefully when printing single-element tuples. - - - - - 1fe806d3 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add hi_core flavour transformer The hi_core flavour transformer enables -fwrite-if-simplified-core for stage1 libraries, which emit core into interface files to make it possible to restart code generation. Building boot libs with it makes it easier to use GHC API to prototype experimental backends that needs core/stg at link time. - - - - - 317cad26 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add missing docs for recently added flavour transformers - - - - - 658f4446 by Ben Gamari at 2023-01-23T04:49:23-05:00 gitlab-ci: Add Rocky8 jobs Addresses #22268. - - - - - a83ec778 by Vladislav Zavialov at 2023-01-23T04:49:58-05:00 Set "since: 9.8" for TypeAbstractions and -Wterm-variable-capture These flags did not make it into the 9.6 release series, so the "since" annotations must be corrected. - - - - - fec7c2ea by Alan Zimmerman at 2023-01-23T04:50:33-05:00 EPA: Add SourceText to HsOverLabel To be able to capture string literals with possible escape codes as labels. Close #22771 - - - - - 3efd1e99 by Ben Gamari at 2023-01-23T04:51:08-05:00 template-haskell: Bump version to 2.20.0.0 Updates `text` and `exceptions` submodules for bounds bumps. Addresses #22767. - - - - - 0900b584 by Cheng Shao at 2023-01-23T04:51:45-05:00 hadrian: disable alloca for in-tree GMP on wasm32 When building in-tree GMP for wasm32, disable its alloca usage, since it may potentially cause stack overflow (e.g. #22602). - - - - - db0f1bfd by Cheng Shao at 2023-01-23T04:52:21-05:00 Bump process submodule Includes a critical fix for wasm32, see https://github.com/haskell/process/pull/272 for details. Also changes the existing cross test to include process stuff and avoid future regression here. - - - - - 9222b167 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Fix subdir for windows bindist - - - - - 9a9bec57 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Remove viPostRemove field from generated metadata This has been removed from the downstream metadata. - - - - - 82884ce0 by Simon Peyton Jones at 2023-01-23T04:53:32-05:00 Fix #22742 runtimeRepLevity_maybe was panicing unnecessarily; and the error printing code made use of the case when it should return Nothing rather than panicing. For some bizarre reason perf/compiler/T21839r shows a 10% bump in runtime peak-megagbytes-used, on a single architecture (alpine). See !9753 for commentary, but I'm going to accept it. Metric Increase: T21839r - - - - - 2c6deb18 by Bryan Richter at 2023-01-23T14:12:22+02:00 codeowners: Add Ben, Matt, and Bryan to CI - - - - - eee3bf05 by Matthew Craven at 2023-01-23T21:46:41-05:00 Do not collect compile-time metrics for T21839r ...the testsuite doesn't handle this properly since it also collects run-time metrics. Compile-time metrics for this test are already tracked via T21839c. Metric Decrease: T21839r - - - - - 1d1dd3fb by Matthew Pickering at 2023-01-24T05:37:52-05:00 Fix recompilation checking for multiple home units The key part of this change is to store a UnitId in the `UsageHomeModule` and `UsageHomeModuleInterface`. * Fine-grained dependency tracking is used if the dependency comes from any home unit. * We actually look up the right module when checking whether we need to recompile in the `UsageHomeModuleInterface` case. These scenarios are both checked by the new tests ( multipleHomeUnits_recomp and multipleHomeUnits_recomp_th ) Fixes #22675 - - - - - 7bfb30f9 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Augment target filepath by working directory when checking if module satisfies target This fixes a spurious warning in -Wmissing-home-modules. This is a simple oversight where when looking for the target in the first place we augment the search by the -working-directory flag but then fail to do so when checking this warning. Fixes #22676 - - - - - 69500dd4 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Use NodeKey rather than ModuleName in pruneCache The `pruneCache` function assumes that the list of `CachedInfo` all have unique `ModuleName`, this is not true: * In normal compilation, the same module name can appear for a file and it's boot file. * In multiple home unit compilation the same ModuleName can appear in different units The fix is to use a `NodeKey` as the actual key for the interfaces which includes `ModuleName`, `IsBoot` and `UnitId`. Fixes #22677 - - - - - 336b2b1c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Recompilation checking: Don't try to find artefacts for Interactive & hs-boot combo In interactive mode we don't produce any linkables for hs-boot files. So we also need to not going looking for them when we check to see if we have all the right objects needed for recompilation. Ticket #22669 - - - - - 6469fea7 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Don't write o-boot files in Interactive mode We should not be producing object files when in interactive mode but we still produced the dummy o-boot files. These never made it into a `Linkable` but then confused the recompilation checker. Fixes #22669 - - - - - 06cc0a95 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Improve driver diagnostic messages by including UnitId in message Currently the driver diagnostics don't give any indication about which unit they correspond to. For example `-Wmissing-home-modules` can fire multiple times for each different home unit and gives no indication about which unit it's actually reporting about. Perhaps a longer term fix is to generalise the providence information away from a SrcSpan so that these kind of whole project errors can be reported with an accurate provenance. For now we can just include the `UnitId` in the error message. Fixes #22678 - - - - - 4fe9eaff by Matthew Pickering at 2023-01-24T05:37:52-05:00 Key ModSummary cache by UnitId as well as FilePath Multiple units can refer to the same files without any problem. Just another assumption which needs to be updated when we may have multiple home units. However, there is the invariant that within each unit each file only maps to one module, so as long as we also key the cache by UnitId then we are all good. This led to some confusing behaviour in GHCi when reloading, multipleHomeUnits_shared distils the essence of what can go wrong. Fixes #22679 - - - - - ada29f5c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Finder: Look in current unit before looking in any home package dependencies In order to preserve existing behaviour it's important to look within the current component before consideirng a module might come from an external component. This already happened by accident in `downsweep`, (because roots are used to repopulated the cache) but in the `Finder` the logic was the wrong way around. Fixes #22680 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp -------------------------p - - - - - be701cc6 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Debug: Print full NodeKey when pretty printing ModuleGraphNode This is helpful when debugging multiple component issues. - - - - - 34d2d463 by Krzysztof Gogolewski at 2023-01-24T05:38:32-05:00 Fix Lint check for duplicate external names Lint was checking for duplicate external names by calling removeDups, which needs a comparison function that is passed to Data.List.sortBy. But the comparison was not a valid ordering - it returned LT if one of the names was not external. For example, the previous implementation won't find a duplicate in [M.x, y, M.x]. Instead, we filter out non-external names before looking for duplicates. - - - - - 1c050ed2 by Matthew Pickering at 2023-01-24T05:39:08-05:00 Add test for T22671 This was fixed by b13c6ea5 Closes #22671 - - - - - 05e6a2d9 by Tom Ellis at 2023-01-24T12:10:52-05:00 Clarify where `f` is defined - - - - - d151546e by Cheng Shao at 2023-01-24T12:11:29-05:00 CmmToC: fix CmmRegOff for 64-bit register on a 32-bit target We used to print the offset value to a platform word sized integer. This is incorrect when the offset is negative (e.g. output of cmm constant folding) and the register is 64-bit but on a 32-bit target, and may lead to incorrect runtime result (e.g. #22607). The fix is simple: just treat it as a proper MO_Add, with the correct width info inferred from the register itself. Metric Increase: T12707 T13379 T4801 T5321FD T5321Fun - - - - - 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 - - - - - 1bd32a35 by Sylvain Henry at 2023-01-26T12:34:21-05:00 Factorize hptModulesBelow Create and use moduleGraphModulesBelow in GHC.Unit.Module.Graph that doesn't need anything from the driver to be used. - - - - - 1262d3f8 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Store dehydrated data structures in CgModBreaks This fixes a tricky leak in GHCi where we were retaining old copies of HscEnvs when reloading. If not all modules were recompiled then these hydrated fields in break points would retain a reference to the old HscEnv which could double memory usage. Fixes #22530 - - - - - e27eb80c by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force more in NFData Name instance Doesn't force the lazy `OccName` field (#19619) which is already known as a really bad source of leaks. When we slam the hammer storing Names on disk (in interface files or the like), all this should be forced as otherwise a `Name` can easily retain an `Id` and hence the entire world. Fixes #22833 - - - - - 3d004d5a by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force OccName in tidyTopName This occname has just been derived from an `Id`, so need to force it promptly so we can release the Id back to the world. Another symptom of the bug caused by #19619 - - - - - f2a0fea0 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Strict fields in ModNodeKey (otherwise retains HomeModInfo) Towards #22530 - - - - - 5640cb1d by Sylvain Henry at 2023-01-26T12:35:36-05:00 Hadrian: fix doc generation Was missing dependencies on files generated by templates (e.g. ghc.cabal) - - - - - 3e827c3f by Richard Eisenberg at 2023-01-26T20:06:53-05:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. - - - - - b3ef5c89 by doyougnu at 2023-01-26T20:07:48-05:00 tryFillBuffer: strictify more speculative bangs - - - - - d0d7ba0f by Vladislav Zavialov at 2023-01-26T20:08:25-05:00 base: NoImplicitPrelude in Data.Void and Data.Kind This change removes an unnecessary dependency on Prelude from two modules in the base package. - - - - - fa1db923 by Matthew Pickering at 2023-01-26T20:09:00-05: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 - - - - - 807310a1 by Matthew Pickering at 2023-01-26T20:09:00-05:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. - - - - - c7116b10 by Ben Gamari at 2023-01-26T20:09:35-05:00 base: Make changelog proposal references more consistent Addresses #22773. - - - - - 6932cfc7 by Sylvain Henry at 2023-01-26T20:10:27-05:00 Fix spurious change from !9568 - - - - - e480fbc2 by Ben Gamari at 2023-01-27T05:01:24-05:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 - - - - - 2648c09c by Andrei Borzenkov at 2023-01-27T05:02:07-05:00 Replace errors from badOrigBinding with new one (#22839) Problem: in 02279a9c the type-level [] syntax was changed from a built-in name to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if a name is not built-in then it must have come from TH quotation, but this is not necessarily the case with []. The outdated assumption in badOrigBinding leads to incorrect error messages. This code: data [] Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []" Unfortunately, there is not enough information in RdrName to directly determine if the name was constructed via TH or by the parser, so this patch changes the error message instead. It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote into a new error TcRnBindingOfExistingName and changes its wording to avoid guessing the origin of the name. - - - - - 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 11b1efe3 by Sven Tennie at 2023-02-04T15:46:14+00:00 ghc-heap: Decode StgStack and its frames Previously, ghc-heap could only decode heap closures. The approach is explained in detail in note [Decoding the stack]. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/nix/sources.json - .gitlab/darwin/toolchain.nix - + .gitlab/gen-ci.cabal - .gitlab/gen_ci.hs - + .gitlab/generate_job_metadata - .gitlab/generate_jobs - .gitlab/hello.hs - + .gitlab/hie.yaml - .gitlab/jobs.yaml - + .gitlab/rel_eng/default.nix - + .gitlab/rel_eng/fetch-gitlab-artifacts/.gitignore - + .gitlab/rel_eng/fetch-gitlab-artifacts/README.mkd - + .gitlab/rel_eng/fetch-gitlab-artifacts/default.nix - + .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - + .gitlab/rel_eng/fetch-gitlab-artifacts/setup.py - + .gitlab/rel_eng/mk-ghcup-metadata/.gitignore - + .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - + .gitlab/rel_eng/mk-ghcup-metadata/default.nix - + .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - + .gitlab/rel_eng/mk-ghcup-metadata/setup.py - + .gitlab/rel_eng/nix/sources.json - + .gitlab/rel_eng/nix/sources.nix - + .gitlab/rel_eng/upload.sh - .gitlab/upload_ghc_libs.py → .gitlab/rel_eng/upload_ghc_libs.py - CODEOWNERS - INSTALL.md - boot - cabal.project-reinstall The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d5eca62068019172d87da9451cde56bf527141c3...11b1efe3c80711c231d4785fee1b88452fbd62be -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d5eca62068019172d87da9451cde56bf527141c3...11b1efe3c80711c231d4785fee1b88452fbd62be You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Feb 4 16:52:43 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sat, 04 Feb 2023 11:52:43 -0500 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] Use ghc version based #if Message-ID: <63de8d5b544d9_1108fe526488352a@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: df6421b1 by Sven Tennie at 2023-02-04T16:52:15+00:00 Use ghc version based #if - - - - - 1 changed file: - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs Changes: ===================================== libraries/ghc-heap/GHC/Exts/Heap/Closures.hs ===================================== @@ -24,7 +24,7 @@ module GHC.Exts.Heap.Closures ( , Box(..) , areBoxesEqual , asBox -#if MIN_VERSION_base(4,17,0) +#if MIN_TOOL_VERSION_ghc(9,5,0) , SfiKind(..) , StackFrameIter(..) #endif @@ -54,7 +54,7 @@ import GHC.Exts import GHC.Generics import Numeric -#if MIN_VERSION_base(4,17,0) +#if MIN_TOOL_VERSION_ghc(9,5,0) import GHC.Stack.CloneStack (StackSnapshot(..)) import GHC.Exts.StackConstants import Unsafe.Coerce (unsafeCoerce) @@ -69,16 +69,11 @@ foreign import prim "aToWordzh" aToWord# :: Any -> Word# foreign import prim "reallyUnsafePtrEqualityUpToTag" reallyUnsafePtrEqualityUpToTag# :: Any -> Any -> Int# -#if MIN_VERSION_base(4,17,0) +#if MIN_TOOL_VERSION_ghc(9,5,0) foreign import prim "stackSnapshotToWordzh" stackSnapshotToWord# :: StackSnapshot# -> Word# foreign import prim "eqStackSnapshotszh" eqStackSnapshots# :: StackSnapshot# -> StackSnapshot# -> Word# -#endif --- | An arbitrary Haskell value in a safe Box. The point is that even --- unevaluated thunks can safely be moved around inside the Box, and when --- required, e.g. in 'getBoxedClosureData', the function knows how far it has --- to evaluate the argument. -#if MIN_VERSION_base(4,17,0) + data SfiKind = SfiClosure | SfiPrimitive | SfiStack deriving (Eq, Show) @@ -104,8 +99,25 @@ instance Show StackSnapshot where addr = W# (stackSnapshotToWord# s#) pad_out ls = '0':'x':ls -data Box = Box Any | StackFrameBox StackFrameIter +-- | An arbitrary Haskell value in a safe Box. +-- +-- The point is that even unevaluated thunks can safely be moved around inside +-- the Box, and when required, e.g. in 'getBoxedClosureData', the function knows +-- how far it has to evaluate the argument. +-- +-- `Box`es can be used to increase (and enforce) laziness: In a graph of +-- closures they can act as a barrier of evaluation. `Closure` is an example for +-- this. +data Box = + -- | A heap located closure. + Box Any + -- | A value or reference to a value on the stack. + | StackFrameBox StackFrameIter #else +-- | An arbitrary Haskell value in a safe Box. The point is that even +-- unevaluated thunks can safely be moved around inside the Box, and when +-- required, e.g. in 'getBoxedClosureData', the function knows how far it has +-- to evaluate the argument. data Box = Box Any #endif @@ -120,7 +132,7 @@ instance Show Box where tag = ptr .&. fromIntegral tAG_MASK -- ((1 `shiftL` TAG_BITS) -1) addr = ptr - tag pad_out ls = '0':'x':ls -#if MIN_VERSION_base(4,17,0) +#if MIN_TOOL_VERSION_ghc(9,5,0) showsPrec _ (StackFrameBox sfi) rs = -- TODO: Record syntax could be nicer to read "(StackFrameBox StackFrameIter(" ++ show sfi ++ ")" ++ rs @@ -133,7 +145,7 @@ areBoxesEqual :: Box -> Box -> IO Bool areBoxesEqual (Box a) (Box b) = case reallyUnsafePtrEqualityUpToTag# a b of 0# -> pure False _ -> pure True -#if MIN_VERSION_base(4,17,0) +#if MIN_TOOL_VERSION_ghc(9,5,0) -- TODO: Could be used for `instance Eq StackFrameIter` areBoxesEqual (StackFrameBox (StackFrameIter s1# i1 p1)) @@ -635,4 +647,3 @@ allClosures (RetFun {..}) = retFunFun : retFunPayload allClosures (RetBCO {..}) = bco : bcoArgs #endif allClosures _ = [] - View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df6421b1079ef20551a5b3fff4a719a1309dd32b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df6421b1079ef20551a5b3fff4a719a1309dd32b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Feb 4 18:17:31 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sat, 04 Feb 2023 13:17:31 -0500 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] validate succeeds Message-ID: <63dea13ba3db3_1108fe35b6a744845990@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: 4a14733b by Sven Tennie at 2023-02-04T18:17:05+00:00 validate succeeds - - - - - 6 changed files: - libraries/base/GHC/Stack/CloneStack.hs - libraries/base/cbits/StackCloningDecoding.cmm - libraries/ghc-heap/GHC/Exts/DecodeStack.hs - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs - libraries/ghc-heap/cbits/Stack.cmm Changes: ===================================== libraries/base/GHC/Stack/CloneStack.hs ===================================== @@ -19,31 +19,38 @@ module GHC.Stack.CloneStack ( StackEntry(..), cloneMyStack, cloneThreadStack, - decode + decode, + stackSnapshotToWord ) where import Control.Concurrent.MVar import Data.Maybe (catMaybes) import Foreign import GHC.Conc.Sync -import GHC.Exts (Int (I#), RealWorld, StackSnapshot#, ThreadId#, Array#, sizeofArray#, indexArray#, State#, StablePtr#, Word#, unsafeCoerce#, eqWord#, isTrue#) +import GHC.Exts (Int (I#), RealWorld, StackSnapshot#, ThreadId#, Array#, sizeofArray#, indexArray#, State#, StablePtr#, Word#) import GHC.IO (IO (..)) import GHC.InfoProv (InfoProv (..), InfoProvEnt, ipLoc, ipeProv, peekInfoProv) import GHC.Stable +import GHC.Word +import Numeric -- | A frozen snapshot of the state of an execution stack. -- -- @since 4.17.0.0 data StackSnapshot = StackSnapshot !StackSnapshot# +instance Show StackSnapshot where + showsPrec _ stack rs = + "StackSnapshot(" ++ pad_out (showHex addr "") ++ ")" ++ rs + where + addr = stackSnapshotToWord stack + pad_out ls = '0':'x':ls --- TODO: Cast to Addr representation instead? -instance Eq StackSnapshot where - (StackSnapshot s1#) == (StackSnapshot s2#) = isTrue# (((unsafeCoerce# s1#) :: Word#) `eqWord#` ((unsafeCoerce# s2#) :: Word#)) +stackSnapshotToWord :: StackSnapshot -> Word +stackSnapshotToWord (StackSnapshot s#) = W# (stackSnapshotToWord# s#) --- TODO: Show and Eq instances are mainly here to fulfill Closure deriving requirements --- instance Show StackSnapshot where --- show _ = "StackSnapshot" +instance Eq StackSnapshot where + s1 == s2 = stackSnapshotToWord s1 == stackSnapshotToWord s2 foreign import prim "stg_decodeStackzh" decodeStack# :: StackSnapshot# -> State# RealWorld -> (# State# RealWorld, Array# (Ptr InfoProvEnt) #) @@ -51,6 +58,8 @@ foreign import prim "stg_cloneMyStackzh" cloneMyStack# :: State# RealWorld -> (# foreign import prim "stg_sendCloneStackMessagezh" sendCloneStackMessage# :: ThreadId# -> StablePtr# PrimMVar -> State# RealWorld -> (# State# RealWorld, (# #) #) +foreign import prim "stackSnapshotToWordzh" stackSnapshotToWord# :: StackSnapshot# -> Word# + {- Note [Stack Cloning] ~~~~~~~~~~~~~~~~~~~~ ===================================== libraries/base/cbits/StackCloningDecoding.cmm ===================================== @@ -24,3 +24,8 @@ stg_decodeStackzh (gcptr stgStack) { return (stackEntries); } + +// Just a cast +stackSnapshotToWordzh(P_ stack) { + return (stack); +} ===================================== libraries/ghc-heap/GHC/Exts/DecodeStack.hs ===================================== @@ -103,11 +103,6 @@ Technical details This keeps the code very portable. -} -foreign import prim "derefStackWordzh" derefStackWord# :: StackSnapshot# -> Word# -> Word# - -derefStackWord :: StackFrameIter -> Word -derefStackWord (StackFrameIter {..}) = W# (derefStackWord# stackSnapshot# (wordOffsetToWord# index)) - foreign import prim "getUpdateFrameTypezh" getUpdateFrameType# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word# #) getUpdateFrameType :: StackFrameIter -> IO UpdateFrameType @@ -123,8 +118,6 @@ getUnderflowFrameNextChunk (StackFrameIter {..}) = IO $ \s -> foreign import prim "getWordzh" getWord# :: StackSnapshot# -> Word# -> Word# -> State# RealWorld -> (# State# RealWorld, Word# #) -foreign import prim "getAddrzh" getAddr# :: StackSnapshot# -> Word# -> Addr# - getWord :: StackFrameIter -> WordOffset -> IO Word getWord (StackFrameIter {..}) relativeOffset = IO $ \s -> case getWord# stackSnapshot# (wordOffsetToWord# index) (wordOffsetToWord# relativeOffset) s of @@ -164,7 +157,7 @@ getInfoTable StackFrameIter {..} | sfiKind == SfiClosure = let infoTablePtr = Ptr (getInfoTableAddr# stackSnapshot# (wordOffsetToWord# index)) in peekItbl infoTablePtr getInfoTable StackFrameIter {..} | sfiKind == SfiStack = peekItbl $ Ptr (getStackInfoTableAddr# stackSnapshot#) -getInfoTable StackFrameIter {..} | sfiKind == SfiPrimitive = error "Primitives have no info table!" +getInfoTable _ = error "Primitives have no info table!" foreign import prim "getBoxedClosurezh" getBoxedClosure# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Any #) ===================================== libraries/ghc-heap/GHC/Exts/Heap.hs ===================================== @@ -194,7 +194,7 @@ getBoxedClosureData b@(StackFrameBox sfi) = trace ("unpack " ++ show b) $ unpack -- @since 8.10.1 closureSize :: Box -> IO Int closureSize (Box x) = pure $ I# (closureSize# x) -#if MIN_VERSION_base(4,17,0) +#if MIN_TOOL_VERSION_ghc(9,5,0) closureSize (StackFrameBox sfi) = unpackStackFrameIter sfi <&> \c -> case c of ===================================== libraries/ghc-heap/GHC/Exts/Heap/Closures.hs ===================================== @@ -55,10 +55,8 @@ import GHC.Generics import Numeric #if MIN_TOOL_VERSION_ghc(9,5,0) -import GHC.Stack.CloneStack (StackSnapshot(..)) +import GHC.Stack.CloneStack (StackSnapshot(..), stackSnapshotToWord) import GHC.Exts.StackConstants -import Unsafe.Coerce (unsafeCoerce) -import Data.Functor #endif ------------------------------------------------------------------------ @@ -70,10 +68,6 @@ foreign import prim "reallyUnsafePtrEqualityUpToTag" reallyUnsafePtrEqualityUpToTag# :: Any -> Any -> Int# #if MIN_TOOL_VERSION_ghc(9,5,0) -foreign import prim "stackSnapshotToWordzh" stackSnapshotToWord# :: StackSnapshot# -> Word# - -foreign import prim "eqStackSnapshotszh" eqStackSnapshots# :: StackSnapshot# -> StackSnapshot# -> Word# - data SfiKind = SfiClosure | SfiPrimitive | SfiStack deriving (Eq, Show) @@ -88,15 +82,7 @@ instance Show StackFrameIter where -- TODO: Record syntax could be nicer to read "StackFrameIter(" ++ pad_out (showHex addr "") ++ ", " ++ show i ++ ", " ++ show p ++ ")" ++ rs where - addr = W# (stackSnapshotToWord# s#) - pad_out ls = '0':'x':ls - -instance Show StackSnapshot where - showsPrec _ (StackSnapshot s#) rs = - -- TODO: Record syntax could be nicer to read - "StackSnapshot(" ++ pad_out (showHex addr "") ++ ")" ++ rs - where - addr = W# (stackSnapshotToWord# s#) + addr = stackSnapshotToWord (StackSnapshot s#) pad_out ls = '0':'x':ls -- | An arbitrary Haskell value in a safe Box. @@ -149,10 +135,11 @@ areBoxesEqual (Box a) (Box b) = case reallyUnsafePtrEqualityUpToTag# a b of -- TODO: Could be used for `instance Eq StackFrameIter` areBoxesEqual (StackFrameBox (StackFrameIter s1# i1 p1)) - (StackFrameBox (StackFrameIter s2# i2 p2)) = pure $ - W# (eqStackSnapshots# s1# s2#) == 1 - && i1 == i2 - && p1 == p2 + (StackFrameBox (StackFrameIter s2# i2 p2)) = + pure $ + (StackSnapshot s1#) == (StackSnapshot s2#) + && i1 == i2 + && p1 == p2 areBoxesEqual _ _ = pure False #endif ===================================== libraries/ghc-heap/cbits/Stack.cmm ===================================== @@ -43,13 +43,6 @@ advanceStackFrameIterzh (P_ stack, W_ offsetWords) { return (newStack, newOffsetWords, hasNext); } -derefStackWordzh (P_ stack, W_ offsetWords) { - P_ sp; - sp = StgStack_sp(stack); - - return (W_[sp + WDS(offsetWords)]); -} - getSmallBitmapzh(P_ stack, W_ offsetWords) { P_ c; c = StgStack_sp(stack) + WDS(offsetWords); @@ -182,17 +175,6 @@ getStackInfoTableAddrzh(P_ stack){ return (info); } -// Just a cast -stackSnapshotToWordzh(P_ stack) { - return (stack); -} - -eqStackSnapshotszh(P_ stack1, P_ stack2) { - ccall checkSTACK(stack1); - ccall checkSTACK(stack2); - return (stack1 == stack2); -} - getBoxedClosurezh(P_ stack, W_ offsetWords){ ccall debugBelch("getBoxedClosurezh - stack %p , offsetWords %lu", stack, offsetWords); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4a14733bb7130f1518df414d477ba4178b7ab952 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4a14733bb7130f1518df414d477ba4178b7ab952 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Feb 4 19:37:24 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sat, 04 Feb 2023 14:37:24 -0500 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] Remove debug belch Message-ID: <63deb3f4c099e_1108fedca32a085798e@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: b740db45 by Sven Tennie at 2023-02-04T19:37:05+00:00 Remove debug belch - - - - - 1 changed file: - rts/sm/Sanity.c Changes: ===================================== rts/sm/Sanity.c ===================================== @@ -62,7 +62,6 @@ checkSmallBitmap( StgPtr payload, StgWord bitmap, uint32_t size ) { uint32_t i; - debugBelch("checkSmallBitmap - payload %p , bitmap %lu, size %u\n", payload, bitmap, size); for(i = 0; i < size; i++, bitmap >>= 1 ) { if ((bitmap & 1) == 0) { checkClosureShallow((StgClosure *)payload[i]); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b740db459e6457f4d617c6779ee3b76867e49f18 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b740db459e6457f4d617c6779ee3b76867e49f18 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Feb 4 19:57:19 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sat, 04 Feb 2023 14:57:19 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/int-index/visibility-check Message-ID: <63deb89f951c1_1108fe52620858498@gitlab.mail> Vladislav Zavialov pushed new branch wip/int-index/visibility-check at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/int-index/visibility-check You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Feb 4 20:00:46 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sat, 04 Feb 2023 15:00:46 -0500 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] Split StackFrameIterator into separate constructors Message-ID: <63deb96e4b809_1108fe5265c862227@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: 6f861873 by Sven Tennie at 2023-02-04T20:00:02+00:00 Split StackFrameIterator into separate constructors - - - - - 2 changed files: - libraries/ghc-heap/GHC/Exts/DecodeStack.hs - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs Changes: ===================================== libraries/ghc-heap/GHC/Exts/DecodeStack.hs ===================================== @@ -106,29 +106,36 @@ Technical details foreign import prim "getUpdateFrameTypezh" getUpdateFrameType# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word# #) getUpdateFrameType :: StackFrameIter -> IO UpdateFrameType -getUpdateFrameType (StackFrameIter {..}) = (toEnum . fromInteger . toInteger) <$> IO (\s -> +getUpdateFrameType (SfiClosure {..}) = (toEnum . fromInteger . toInteger) <$> IO (\s -> case (getUpdateFrameType# stackSnapshot# (wordOffsetToWord# index) s) of (# s1, uft# #) -> (# s1, W# uft# #)) +getUpdateFrameType sfi = error $ "Unexpected StackFrameIter type: " ++ show sfi foreign import prim "getUnderflowFrameNextChunkzh" getUnderflowFrameNextChunk# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, StackSnapshot# #) getUnderflowFrameNextChunk :: StackFrameIter -> IO StackSnapshot -getUnderflowFrameNextChunk (StackFrameIter {..}) = IO $ \s -> +getUnderflowFrameNextChunk (SfiClosure {..}) = IO $ \s -> case getUnderflowFrameNextChunk# stackSnapshot# (wordOffsetToWord# index) s of (# s1, stack# #) -> (# s1, StackSnapshot stack# #) +getUnderflowFrameNextChunk sfi = error $ "Unexpected StackFrameIter type: " ++ show sfi foreign import prim "getWordzh" getWord# :: StackSnapshot# -> Word# -> Word# -> State# RealWorld -> (# State# RealWorld, Word# #) getWord :: StackFrameIter -> WordOffset -> IO Word -getWord (StackFrameIter {..}) relativeOffset = IO $ \s -> +getWord (SfiPrimitive {..}) relativeOffset = IO $ \s -> case getWord# stackSnapshot# (wordOffsetToWord# index) (wordOffsetToWord# relativeOffset) s of (# s1, w# #) -> (# s1, W# w# #) +getWord (SfiClosure {..}) relativeOffset = IO $ \s -> + case getWord# stackSnapshot# (wordOffsetToWord# index) (wordOffsetToWord# relativeOffset) s of + (# s1, w# #) -> (# s1, W# w# #) +getWord sfi _ = error $ "Unexpected StackFrameIter type: " ++ show sfi foreign import prim "getRetFunTypezh" getRetFunType# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word# #) -- TODO: Could use getWord getRetFunType :: StackFrameIter -> IO RetFunType -getRetFunType (StackFrameIter {..}) = (toEnum . fromInteger . toInteger) <$> IO (\s -> +getRetFunType (SfiClosure {..}) = (toEnum . fromInteger . toInteger) <$> IO (\s -> case (getRetFunType# stackSnapshot# (wordOffsetToWord# index) s) of (# s1, rft# #) -> (# s1, W# rft# #)) +getRetFunType sfi = error $ "Unexpected StackFrameIter type: " ++ show sfi foreign import prim "getLargeBitmapzh" getLargeBitmap# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, ByteArray#, Word# #) @@ -141,8 +148,9 @@ foreign import prim "getSmallBitmapzh" getSmallBitmap# :: StackSnapshot# -> Word foreign import prim "getRetSmallSpecialTypezh" getRetSmallSpecialType# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word# #) getRetSmallSpecialType :: StackFrameIter -> IO SpecialRetSmall -getRetSmallSpecialType (StackFrameIter {..}) = (toEnum . fromInteger . toInteger) <$> IO (\s -> +getRetSmallSpecialType (SfiClosure {..}) = (toEnum . fromInteger . toInteger) <$> IO (\s -> case (getRetSmallSpecialType# stackSnapshot# (wordOffsetToWord# index) s) of (# s1, rft# #) -> (# s1, W# rft# #)) +getRetSmallSpecialType sfi = error $ "Unexpected StackFrameIter type: " ++ show sfi foreign import prim "getRetFunSmallBitmapzh" getRetFunSmallBitmap# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word#, Word# #) @@ -153,10 +161,10 @@ foreign import prim "getInfoTableAddrzh" getInfoTableAddr# :: StackSnapshot# -> foreign import prim "getStackInfoTableAddrzh" getStackInfoTableAddr# :: StackSnapshot# -> Addr# getInfoTable :: StackFrameIter -> IO StgInfoTable -getInfoTable StackFrameIter {..} | sfiKind == SfiClosure = +getInfoTable SfiClosure {..} = let infoTablePtr = Ptr (getInfoTableAddr# stackSnapshot# (wordOffsetToWord# index)) in peekItbl infoTablePtr -getInfoTable StackFrameIter {..} | sfiKind == SfiStack = peekItbl $ Ptr (getStackInfoTableAddr# stackSnapshot#) +getInfoTable SfiStackClosure {..} = peekItbl $ Ptr (getStackInfoTableAddr# stackSnapshot#) getInfoTable _ = error "Primitives have no info table!" foreign import prim "getBoxedClosurezh" getBoxedClosure# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Any #) @@ -164,21 +172,23 @@ foreign import prim "getBoxedClosurezh" getBoxedClosure# :: StackSnapshot# -> Wo foreign import prim "getStackFieldszh" getStackFields# :: StackSnapshot# -> State# RealWorld -> (# State# RealWorld, Word32#, Word8#, Word8# #) getStackFields :: StackFrameIter -> IO (Word32, Word8, Word8) -getStackFields StackFrameIter {..} = IO $ \s -> +getStackFields SfiStackClosure {..} = IO $ \s -> case getStackFields# stackSnapshot# s of (# s1, sSize#, sDirty#, sMarking# #) -> (# s1, (W32# sSize#, W8# sDirty#, W8# sMarking#) #) +getStackFields sfi = error $ "Unexpected StackFrameIter type: " ++ show sfi -- | Get an interator starting with the top-most stack frame stackHead :: StackSnapshot -> StackFrameIter -stackHead (StackSnapshot s) = StackFrameIter s 0 SfiClosure -- GHC stacks are never empty +stackHead (StackSnapshot s) = SfiClosure s 0 -- GHC stacks are never empty -- | Advance iterator to the next stack frame (if any) advanceStackFrameIter :: StackFrameIter -> Maybe StackFrameIter -advanceStackFrameIter (StackFrameIter {..}) = +advanceStackFrameIter (SfiClosure {..}) = let !(# s', i', hasNext #) = advanceStackFrameIter# stackSnapshot# (wordOffsetToWord# index) in if (I# hasNext) > 0 - then Just $ StackFrameIter s' (primWordToWordOffset i') SfiClosure + then Just $ SfiClosure s' (primWordToWordOffset i') else Nothing +advanceStackFrameIter sfi = error $ "Unexpected StackFrameIter type: " ++ show sfi primWordToWordOffset :: Word# -> WordOffset primWordToWordOffset w# = fromIntegral (W# w#) @@ -191,52 +201,58 @@ wordsToBitmapEntries sfi (b : bs) bitmapSize = let entries = toBitmapEntries sfi b (min bitmapSize (fromIntegral wORD_SIZE_IN_BITS)) mbLastFrame = (listToMaybe . reverse) entries in case mbLastFrame of - Just (StackFrameIter {..}) -> - entries ++ wordsToBitmapEntries (StackFrameIter stackSnapshot# (index + 1) SfiClosure) bs (subtractDecodedBitmapWord bitmapSize) - Nothing -> error "This should never happen! Recursion ended not in base case." + Just (SfiClosure {..}) -> + entries ++ wordsToBitmapEntries (SfiClosure stackSnapshot# (index + 1)) bs (subtractDecodedBitmapWord bitmapSize) + Just (SfiPrimitive {..}) -> + entries ++ wordsToBitmapEntries (SfiClosure stackSnapshot# (index + 1)) bs (subtractDecodedBitmapWord bitmapSize) + _ -> error "This should never happen! Recursion ended not in base case." where subtractDecodedBitmapWord :: Word -> Word subtractDecodedBitmapWord bSize = fromIntegral $ max 0 ((fromIntegral bSize) - wORD_SIZE_IN_BITS) toBitmapEntries :: StackFrameIter -> Word -> Word -> [StackFrameIter] toBitmapEntries _ _ 0 = [] -toBitmapEntries sfi@(StackFrameIter {..}) bitmapWord bSize = +toBitmapEntries (SfiClosure {..}) bitmapWord bSize = -- TODO: overriding isPrimitive field is a bit weird. Could be calculated before - sfi { - sfiKind = if (bitmapWord .&. 1) /= 0 then SfiPrimitive else SfiClosure - } - : toBitmapEntries (StackFrameIter stackSnapshot# (index + 1) SfiClosure) (bitmapWord `shiftR` 1) (bSize - 1) + (if (bitmapWord .&. 1) /= 0 then SfiPrimitive stackSnapshot# index else SfiClosure stackSnapshot# index) + : toBitmapEntries (SfiClosure stackSnapshot# (index + 1)) (bitmapWord `shiftR` 1) (bSize - 1) +toBitmapEntries sfi _ _ = error $ "Unexpected StackFrameIter type: " ++ show sfi toBitmapPayload :: StackFrameIter -> IO Box -toBitmapPayload sfi | sfiKind sfi == SfiPrimitive = pure (StackFrameBox sfi) -toBitmapPayload sfi = getClosure sfi 0 +toBitmapPayload sfi at SfiPrimitive{} = pure (StackFrameBox sfi) +toBitmapPayload sfi at SfiClosure{} = getClosure sfi 0 +toBitmapPayload sfi = error $ "Unexpected StackFrameIter type: " ++ show sfi getClosure :: StackFrameIter -> WordOffset -> IO Box -getClosure sfi at StackFrameIter {..} relativeOffset = trace ("getClosure " ++ show sfi ++ " " ++ show relativeOffset) $ +getClosure sfi at SfiClosure {..} relativeOffset = trace ("getClosure " ++ show sfi ++ " " ++ show relativeOffset) $ IO $ \s -> case (getBoxedClosure# stackSnapshot# (wordOffsetToWord# (index + relativeOffset)) s) of (# s1, ptr #) -> (# s1, Box ptr #) +getClosure sfi _ = error $ "Unexpected StackFrameIter type: " ++ show sfi decodeLargeBitmap :: (StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, ByteArray#, Word# #)) -> StackFrameIter -> WordOffset -> IO [Box] -decodeLargeBitmap getterFun# sfi@(StackFrameIter {..}) relativePayloadOffset = do +decodeLargeBitmap getterFun# sfi@(SfiClosure {..}) relativePayloadOffset = do (bitmapArray, size) <- IO $ \s -> case getterFun# stackSnapshot# (wordOffsetToWord# index) s of (# s1, ba#, s# #) -> (# s1, (ByteArray ba#, W# s#) #) let bitmapWords :: [Word] = byteArrayToList bitmapArray decodeBitmaps sfi relativePayloadOffset bitmapWords size +decodeLargeBitmap _ sfi _ = error $ "Unexpected StackFrameIter type: " ++ show sfi decodeBitmaps :: StackFrameIter -> WordOffset -> [Word] -> Word -> IO [Box] -decodeBitmaps (StackFrameIter {..}) relativePayloadOffset bitmapWords size = - let bes = wordsToBitmapEntries (StackFrameIter stackSnapshot# (index + relativePayloadOffset) SfiClosure) bitmapWords size +decodeBitmaps (SfiClosure {..}) relativePayloadOffset bitmapWords size = + let bes = wordsToBitmapEntries (SfiClosure stackSnapshot# (index + relativePayloadOffset)) bitmapWords size in mapM toBitmapPayload bes +decodeBitmaps sfi _ _ _ = error $ "Unexpected StackFrameIter type: " ++ show sfi decodeSmallBitmap :: (StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word#, Word# #)) -> StackFrameIter -> WordOffset -> IO [Box] -decodeSmallBitmap getterFun# sfi@(StackFrameIter {..}) relativePayloadOffset = do +decodeSmallBitmap getterFun# sfi@(SfiClosure {..}) relativePayloadOffset = do (bitmap, size) <- IO $ \s -> case getterFun# stackSnapshot# (wordOffsetToWord# index) s of (# s1, b# , s# #) -> (# s1, (W# b# , W# s#) #) let bitmapWords = if size > 0 then [bitmap] else [] decodeBitmaps sfi relativePayloadOffset bitmapWords size +decodeSmallBitmap _ sfi _ = error $ "Unexpected StackFrameIter type: " ++ show sfi byteArrayToList :: ByteArray -> [Word] byteArrayToList (ByteArray bArray) = go 0 @@ -250,8 +266,8 @@ wordOffsetToWord# :: WordOffset -> Word# wordOffsetToWord# wo = intToWord# (fromIntegral wo) unpackStackFrameIter :: StackFrameIter -> IO Closure -unpackStackFrameIter sfi | sfiKind sfi == SfiPrimitive = UnknownTypeWordSizedPrimitive <$> (getWord sfi 0) -unpackStackFrameIter sfi | sfiKind sfi == SfiStack = do +unpackStackFrameIter sfi@(SfiPrimitive { }) = UnknownTypeWordSizedPrimitive <$> (getWord sfi 0) +unpackStackFrameIter sfi@(SfiStackClosure {}) = do info <- getInfoTable sfi (stack_size', stack_dirty', stack_marking') <- getStackFields sfi case tipe info of @@ -265,7 +281,7 @@ unpackStackFrameIter sfi | sfiKind sfi == SfiStack = do stack = stack' } _ -> error $ "Expected STACK closure, got " ++ show info -unpackStackFrameIter sfi = do +unpackStackFrameIter sfi@(SfiClosure {}) = do traceM $ "unpackStackFrameIter - sfi " ++ show sfi info <- getInfoTable sfi res <- unpackStackFrameIter' info @@ -334,11 +350,7 @@ unpackStackFrameIter sfi = do (StackSnapshot nextChunk') <- getUnderflowFrameNextChunk sfi pure $ UnderflowFrame { info = info, - nextChunk = StackFrameBox $ StackFrameIter { - stackSnapshot# = nextChunk', - index = 0, - sfiKind = SfiStack - } + nextChunk = StackFrameBox $ SfiStackClosure nextChunk' } STOP_FRAME -> pure $ StopFrame {info = info} ATOMICALLY_FRAME -> do @@ -383,11 +395,8 @@ intToWord# :: Int -> Word# intToWord# i = int2Word# (toInt# i) decodeStack :: StackSnapshot -> IO Closure -decodeStack (StackSnapshot stack#) = unpackStackFrameIter $ StackFrameIter { - stackSnapshot# = stack#, - index = 0, - sfiKind = SfiStack - } +decodeStack (StackSnapshot stack#) = unpackStackFrameIter $ SfiStackClosure stack# + decodeStack' :: StackSnapshot -> [Box] decodeStack' s = StackFrameBox (stackHead s) : go (advanceStackFrameIter (stackHead s)) where ===================================== libraries/ghc-heap/GHC/Exts/Heap/Closures.hs ===================================== @@ -25,7 +25,6 @@ module GHC.Exts.Heap.Closures ( , areBoxesEqual , asBox #if MIN_TOOL_VERSION_ghc(9,5,0) - , SfiKind(..) , StackFrameIter(..) #endif ) where @@ -68,19 +67,46 @@ foreign import prim "reallyUnsafePtrEqualityUpToTag" reallyUnsafePtrEqualityUpToTag# :: Any -> Any -> Int# #if MIN_TOOL_VERSION_ghc(9,5,0) -data SfiKind = SfiClosure | SfiPrimitive | SfiStack - deriving (Eq, Show) - -data StackFrameIter = StackFrameIter - { stackSnapshot# :: !StackSnapshot#, - index :: !WordOffset, - sfiKind :: !SfiKind - } +-- | Iterator state for stack decoding +data StackFrameIter = + -- | Represents a `StackClosure` / @StgStack@ + SfiStackClosure + { stackSnapshot# :: !StackSnapshot# } + -- | Represents a closure on the stack + | SfiClosure + { stackSnapshot# :: !StackSnapshot#, + index :: !WordOffset + } + -- | Represents a primitive word on the stack + | SfiPrimitive + { stackSnapshot# :: !StackSnapshot#, + index :: !WordOffset + } +instance Eq StackFrameIter where + (SfiStackClosure s1#) == (SfiStackClosure s2#) = (StackSnapshot s1#) == (StackSnapshot s2#) + (SfiClosure s1# i1) == (SfiClosure s2# i2) = + (StackSnapshot s1#) == (StackSnapshot s2#) + && i1 == i2 + (SfiPrimitive s1# i1) == (SfiPrimitive s2# i2) = + (StackSnapshot s1#) == (StackSnapshot s2#) + && i1 == i2 + _ == _ = False + +-- TODO: Reduce duplication in where clause instance Show StackFrameIter where - showsPrec _ (StackFrameIter s# i p) rs = - -- TODO: Record syntax could be nicer to read - "StackFrameIter(" ++ pad_out (showHex addr "") ++ ", " ++ show i ++ ", " ++ show p ++ ")" ++ rs + showsPrec _ (SfiStackClosure s#) rs = + "SfiStackClosure { stackSnapshot# = " ++ pad_out (showHex addr "") ++ "}" ++ rs + where + addr = stackSnapshotToWord (StackSnapshot s#) + pad_out ls = '0':'x':ls + showsPrec _ (SfiClosure s# i ) rs = + "SfiClosure { stackSnapshot# = " ++ pad_out (showHex addr "") ++ ", index = " ++ show i ++ ", " ++ "}" ++ rs + where + addr = stackSnapshotToWord (StackSnapshot s#) + pad_out ls = '0':'x':ls + showsPrec _ (SfiPrimitive s# i ) rs = + "SfiPrimitive { stackSnapshot# = " ++ pad_out (showHex addr "") ++ ", index = " ++ show i ++ ", " ++ "}" ++ rs where addr = stackSnapshotToWord (StackSnapshot s#) pad_out ls = '0':'x':ls @@ -120,8 +146,7 @@ instance Show Box where pad_out ls = '0':'x':ls #if MIN_TOOL_VERSION_ghc(9,5,0) showsPrec _ (StackFrameBox sfi) rs = - -- TODO: Record syntax could be nicer to read - "(StackFrameBox StackFrameIter(" ++ show sfi ++ ")" ++ rs + "(StackFrameBox " ++ show sfi ++ ")" ++ rs #endif -- | Boxes can be compared, but this is not pure, as different heap objects can, @@ -132,14 +157,8 @@ areBoxesEqual (Box a) (Box b) = case reallyUnsafePtrEqualityUpToTag# a b of 0# -> pure False _ -> pure True #if MIN_TOOL_VERSION_ghc(9,5,0) --- TODO: Could be used for `instance Eq StackFrameIter` -areBoxesEqual - (StackFrameBox (StackFrameIter s1# i1 p1)) - (StackFrameBox (StackFrameIter s2# i2 p2)) = - pure $ - (StackSnapshot s1#) == (StackSnapshot s2#) - && i1 == i2 - && p1 == p2 +areBoxesEqual (StackFrameBox sfi1) (StackFrameBox sfi2) = + pure $ sfi1 == sfi2 areBoxesEqual _ _ = pure False #endif View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6f861873caf2a185ff57f744aeba2847a5565d84 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6f861873caf2a185ff57f744aeba2847a5565d84 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Feb 4 21:48:45 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 04 Feb 2023 16:48:45 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" Message-ID: <63ded2bd98a71_1108fe5265c87586b@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - da0d9939 by Bodigrim at 2023-02-04T16:48:23-05:00 Fix colors in emacs terminal - - - - - 35b15d67 by Bodigrim at 2023-02-04T16:48:24-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - 24 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Data/List/SetOps.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/Iface/Env.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Stg/Lift/Monad.hs - compiler/GHC/SysTools/Terminal.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - libraries/base/GHC/Int.hs - libraries/base/GHC/Word.hs - libraries/base/changelog.md - testsuite/tests/simplCore/should_run/T20203.stderr-ws-32 - testsuite/tests/simplCore/should_run/T20203.stderr-ws-64 - utils/ghc-pkg/Main.hs Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -96,7 +96,6 @@ import Data.Foldable ( for_, toList ) import Data.List.NonEmpty ( NonEmpty(..), groupWith ) import Data.List ( partition ) import Data.Maybe -import Data.Ord ( comparing ) import GHC.Data.Pair import GHC.Base (oneShot) import GHC.Data.Unboxed @@ -478,7 +477,7 @@ lintCoreBindings' cfg binds -- M.n{r3} = ... -- M.n{r29} = ... -- because they both get the same linker symbol - ext_dups = snd $ removeDups (comparing ord_ext) $ + ext_dups = snd $ removeDupsOn ord_ext $ filter isExternalName $ map Var.varName binders ord_ext n = (nameModule n, nameOccName n) ===================================== compiler/GHC/Core/Make.hs ===================================== @@ -648,12 +648,12 @@ mkSmallTupleSelector1 vars the_var scrut_var scrut -- To avoid shadowing, we use uniques to invent new variables. -- -- If necessary we pattern match on a "big" tuple. -mkBigTupleCase :: UniqSupply -- ^ For inventing names of intermediate variables - -> [Id] -- ^ The tuple identifiers to pattern match on; +mkBigTupleCase :: MonadUnique m -- For inventing names of intermediate variables + => [Id] -- ^ The tuple identifiers to pattern match on; -- Bring these into scope in the body -> CoreExpr -- ^ Body of the case -> CoreExpr -- ^ Scrutinee - -> CoreExpr + -> m CoreExpr -- ToDo: eliminate cases where none of the variables are needed. -- -- mkBigTupleCase uniqs [a,b,c,d] body v e @@ -661,11 +661,11 @@ mkBigTupleCase :: UniqSupply -- ^ For inventing names of intermediate vari -- case p of p { (a,b) -> -- case q of q { (c,d) -> -- body }}} -mkBigTupleCase us vars body scrut - = mk_tuple_case wrapped_us (chunkify wrapped_vars) wrapped_body +mkBigTupleCase vars body scrut + = do us <- getUniqueSupplyM + let (wrapped_us, wrapped_vars, wrapped_body) = foldr unwrap (us,[],body) vars + return $ mk_tuple_case wrapped_us (chunkify wrapped_vars) wrapped_body where - (wrapped_us, wrapped_vars, wrapped_body) = foldr unwrap (us,[],body) vars - scrut_ty = exprType scrut unwrap var (us,vars,body) ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -2090,9 +2090,8 @@ dataConInstPat fss uniqs mult con inst_tys arg_ids = zipWith4 mk_id_var id_uniqs id_fss arg_tys arg_strs mk_id_var uniq fs (Scaled m ty) str = setCaseBndrEvald str $ -- See Note [Mark evaluated arguments] - mkLocalIdOrCoVar name (mult `mkMultMul` m) (Type.substTy full_subst ty) - where - name = mkInternalName uniq (mkVarOccFS fs) noSrcSpan + mkUserLocalOrCoVar (mkVarOccFS fs) uniq + (mult `mkMultMul` m) (Type.substTy full_subst ty) noSrcSpan {- Note [Mark evaluated arguments] ===================================== compiler/GHC/Data/List/SetOps.hs ===================================== @@ -18,7 +18,7 @@ module GHC.Data.List.SetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, nubOrdBy, findDupsEq, + hasNoDups, removeDups, removeDupsOn, nubOrdBy, findDupsEq, equivClasses, -- Indexing @@ -37,6 +37,7 @@ import GHC.Utils.Misc import qualified Data.List as L import qualified Data.List.NonEmpty as NE import Data.List.NonEmpty (NonEmpty(..)) +import Data.Ord (comparing) import qualified Data.Set as S getNth :: Outputable a => [a] -> Int -> a @@ -193,6 +194,9 @@ removeDups cmp xs collect_dups dups_so_far (x :| []) = (dups_so_far, x) collect_dups dups_so_far dups@(x :| _) = (dups:dups_so_far, x) +removeDupsOn :: Ord b => (a -> b) -> [a] -> ([a], [NonEmpty a]) +removeDupsOn f x = removeDups (comparing f) x + -- | Remove the duplicates from a list using the provided -- comparison function. nubOrdBy :: (a -> a -> Ordering) -> [a] -> [a] ===================================== compiler/GHC/HsToCore/Arrows.hs ===================================== @@ -158,9 +158,9 @@ because the list of variables is typically not yet defined. -- = case v of v { (x1, .., xn) -> body } -- But the matching may be nested if the tuple is very big -coreCaseTuple :: UniqSupply -> Id -> [Id] -> CoreExpr -> CoreExpr -coreCaseTuple uniqs scrut_var vars body - = mkBigTupleCase uniqs vars body (Var scrut_var) +coreCaseTuple :: Id -> [Id] -> CoreExpr -> DsM CoreExpr +coreCaseTuple scrut_var vars body + = mkBigTupleCase vars body (Var scrut_var) coreCasePair :: Id -> Id -> Id -> CoreExpr -> CoreExpr coreCasePair scrut_var var1 var2 body @@ -231,9 +231,8 @@ matchEnvStack :: [Id] -- x1..xn -> CoreExpr -- e -> DsM CoreExpr matchEnvStack env_ids stack_id body = do - uniqs <- newUniqueSupply tup_var <- newSysLocalDs ManyTy (mkBigCoreVarTupTy env_ids) - let match_env = coreCaseTuple uniqs tup_var env_ids body + match_env <- coreCaseTuple tup_var env_ids body pair_id <- newSysLocalDs ManyTy (mkCorePairTy (idType tup_var) (idType stack_id)) return (Lam pair_id (coreCasePair pair_id tup_var stack_id match_env)) @@ -250,9 +249,9 @@ matchEnv :: [Id] -- x1..xn -> CoreExpr -- e -> DsM CoreExpr matchEnv env_ids body = do - uniqs <- newUniqueSupply tup_id <- newSysLocalDs ManyTy (mkBigCoreVarTupTy env_ids) - return (Lam tup_id (coreCaseTuple uniqs tup_id env_ids body)) + tup_case <- coreCaseTuple tup_id env_ids body + return (Lam tup_id tup_case) ---------------------------------------------- -- matchVarStack @@ -957,11 +956,10 @@ dsCmdStmt ids local_vars out_ids (BindStmt _ pat cmd) env_ids = do -- \ (p, (xs2)) -> (zs) env_id <- newSysLocalDs ManyTy env_ty2 - uniqs <- newUniqueSupply let after_c_ty = mkCorePairTy pat_ty env_ty2 out_ty = mkBigCoreVarTupTy out_ids - body_expr = coreCaseTuple uniqs env_id env_ids2 (mkBigCoreVarTup out_ids) + body_expr <- coreCaseTuple env_id env_ids2 (mkBigCoreVarTup out_ids) fail_expr <- mkFailExpr (StmtCtxt (HsDoStmt (DoExpr Nothing))) out_ty pat_id <- selectSimpleMatchVarL ManyTy pat @@ -1029,12 +1027,11 @@ dsCmdStmt ids local_vars out_ids -- post_loop_fn = \((later_ids),(env2_ids)) -> (out_ids) - uniqs <- newUniqueSupply env2_id <- newSysLocalDs ManyTy env2_ty let later_ty = mkBigCoreVarTupTy later_ids post_pair_ty = mkCorePairTy later_ty env2_ty - post_loop_body = coreCaseTuple uniqs env2_id env2_ids (mkBigCoreVarTup out_ids) + post_loop_body <- coreCaseTuple env2_id env2_ids (mkBigCoreVarTup out_ids) post_loop_fn <- matchEnvStack later_ids env2_id post_loop_body ===================================== compiler/GHC/HsToCore/ListComp.hs ===================================== @@ -444,15 +444,13 @@ mkUnzipBind _ elt_tys ; unzip_fn <- newSysLocalDs ManyTy unzip_fn_ty - ; [us1, us2] <- sequence [newUniqueSupply, newUniqueSupply] - ; let nil_tuple = mkBigCoreTup (map mkNilExpr elt_tys) concat_expressions = map mkConcatExpression (zip3 elt_tys (map Var xs) (map Var xss)) tupled_concat_expression = mkBigCoreTup concat_expressions - folder_body_inner_case = mkBigTupleCase us1 xss tupled_concat_expression (Var axs) - folder_body_outer_case = mkBigTupleCase us2 xs folder_body_inner_case (Var ax) - folder_body = mkLams [ax, axs] folder_body_outer_case + ; folder_body_inner_case <- mkBigTupleCase xss tupled_concat_expression (Var axs) + ; folder_body_outer_case <- mkBigTupleCase xs folder_body_inner_case (Var ax) + ; let folder_body = mkLams [ax, axs] folder_body_outer_case ; unzip_body <- mkFoldrExpr elt_tuple_ty elt_list_tuple_ty folder_body nil_tuple (Var ys) ; return (Just (unzip_fn, mkLams [ys] unzip_body)) } @@ -546,9 +544,8 @@ dsMcStmt (TransStmt { trS_stmts = stmts, trS_bndrs = bndrs ; body <- dsMcStmts stmts_rest ; n_tup_var' <- newSysLocalDs ManyTy n_tup_ty' ; tup_n_expr' <- mkMcUnzipM form fmap_op n_tup_var' from_bndr_tys - ; us <- newUniqueSupply ; let rhs' = mkApps usingExpr' usingArgs' - body' = mkBigTupleCase us to_bndrs body tup_n_expr' + ; body' <- mkBigTupleCase to_bndrs body tup_n_expr' ; dsSyntaxExpr bind_op [rhs', Lam n_tup_var' body'] } @@ -592,9 +589,9 @@ matchTuple :: [Id] -> CoreExpr -> DsM CoreExpr -- returns the Core term -- \x. case x of (a,b,c) -> body matchTuple ids body - = do { us <- newUniqueSupply - ; tup_id <- newSysLocalDs ManyTy (mkBigCoreVarTupTy ids) - ; return (Lam tup_id $ mkBigTupleCase us ids body (Var tup_id)) } + = do { tup_id <- newSysLocalDs ManyTy (mkBigCoreVarTupTy ids) + ; tup_case <- mkBigTupleCase ids body (Var tup_id) + ; return (Lam tup_id tup_case) } -- general `rhs' >>= \pat -> stmts` desugaring where `rhs'` is already a -- desugared `CoreExpr` ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -640,8 +640,7 @@ nameTyCt :: PredType -> DsM EvVar nameTyCt pred_ty = do unique <- getUniqueM let occname = mkVarOccFS (fsLit ("pm_"++show unique)) - idname = mkInternalName unique occname noSrcSpan - return (mkLocalIdOrCoVar idname ManyTy pred_ty) + return (mkUserLocalOrCoVar occname unique ManyTy pred_ty noSrcSpan) ----------------------------- -- ** Adding term constraints ===================================== compiler/GHC/HsToCore/Pmc/Utils.hs ===================================== @@ -51,8 +51,7 @@ traceWhenFailPm herald doc act = MaybeT $ do mkPmId :: Type -> DsM Id mkPmId ty = getUniqueM >>= \unique -> let occname = mkVarOccFS $ fsLit "pm" - name = mkInternalName unique occname noSrcSpan - in return (mkLocalIdOrCoVar name ManyTy ty) + in return (mkUserLocalOrCoVar occname unique ManyTy ty noSrcSpan) {-# NOINLINE mkPmId #-} -- We'll CPR deeply, that should be enough -- | All warning flags that need to run the pattern match checker. ===================================== compiler/GHC/Iface/Env.hs ===================================== @@ -262,9 +262,9 @@ newIfaceName occ newIfaceNames :: [OccName] -> IfL [Name] newIfaceNames occs - = do { uniqs <- newUniqueSupply + = do { uniqs <- getUniquesM ; return [ mkInternalName uniq occ noSrcSpan - | (occ,uniq) <- occs `zip` uniqsFromSupply uniqs] } + | (occ,uniq) <- occs `zip` uniqs] } trace_if :: Logger -> SDoc -> IO () {-# INLINE trace_if #-} ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -1674,8 +1674,7 @@ tcIfaceAlt scrut mult (tycon, inst_tys) (IfaceAlt (IfaceDataAlt data_occ) arg_st tcIfaceDataAlt :: Mult -> DataCon -> [Type] -> [FastString] -> IfaceExpr -> IfL CoreAlt tcIfaceDataAlt mult con inst_tys arg_strs rhs - = do { us <- newUniqueSupply - ; let uniqs = uniqsFromSupply us + = do { uniqs <- getUniquesM ; let (ex_tvs, arg_ids) = dataConRepFSInstPat arg_strs uniqs mult con inst_tys ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -64,7 +64,7 @@ import GHC.Types.Name.Reader import GHC.Types.Unique.Set import GHC.Types.SourceText import GHC.Utils.Misc -import GHC.Data.List.SetOps ( removeDups ) +import GHC.Data.List.SetOps ( removeDupsOn ) import GHC.Utils.Error import GHC.Utils.Panic import GHC.Utils.Panic.Plain @@ -1305,7 +1305,7 @@ rnParallelStmts ctxt return_op segs thing_inside -> [Name] -> [ParStmtBlock GhcPs GhcPs] -> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars) rn_segs _ bndrs_so_far [] - = do { let (bndrs', dups) = removeDups cmpByOcc bndrs_so_far + = do { let (bndrs', dups) = removeDupsOn nameOccName bndrs_so_far ; mapM_ dupErr dups ; (thing, fvs) <- bindLocalNames bndrs' (thing_inside bndrs') ; return (([], thing), fvs) } @@ -1321,7 +1321,6 @@ rnParallelStmts ctxt return_op segs thing_inside ; let seg' = ParStmtBlock x stmts' used_bndrs return_op ; return ((seg':segs', thing), fvs) } - cmpByOcc n1 n2 = nameOccName n1 `compare` nameOccName n2 dupErr vs = addErr $ TcRnListComprehensionDuplicateBinding (NE.head vs) lookupQualifiedDoStmtName :: HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars) ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -62,7 +62,7 @@ import GHC.Driver.Session import GHC.Utils.Misc ( lengthExceeds, partitionWith ) import GHC.Utils.Panic import GHC.Driver.Env ( HscEnv(..), hsc_home_unit) -import GHC.Data.List.SetOps ( findDupsEq, removeDups, equivClasses ) +import GHC.Data.List.SetOps ( findDupsEq, removeDupsOn, equivClasses ) import GHC.Data.Graph.Directed ( SCC, flattenSCC, flattenSCCs, Node(..) , stronglyConnCompFromEdgedVerticesUniq ) import GHC.Types.Unique.Set @@ -1604,7 +1604,7 @@ rnStandaloneKindSignatures -> [LStandaloneKindSig GhcPs] -> RnM [(LStandaloneKindSig GhcRn, FreeVars)] rnStandaloneKindSignatures tc_names kisigs - = do { let (no_dups, dup_kisigs) = removeDups (compare `on` get_name) kisigs + = do { let (no_dups, dup_kisigs) = removeDupsOn get_name kisigs get_name = standaloneKindSigName . unLoc ; mapM_ dupKindSig_Err dup_kisigs ; mapM (wrapLocFstMA (rnStandaloneKindSignature tc_names)) no_dups @@ -1682,7 +1682,7 @@ rnRoleAnnots :: NameSet rnRoleAnnots tc_names role_annots = do { -- Check for duplicates *before* renaming, to avoid -- lumping together all the unboundNames - let (no_dups, dup_annots) = removeDups (compare `on` get_name) role_annots + let (no_dups, dup_annots) = removeDupsOn get_name role_annots get_name = roleAnnotDeclName . unLoc ; mapM_ dupRoleAnnotErr dup_annots ; mapM (wrapLocMA rn_role_annot1) no_dups } ===================================== compiler/GHC/Rename/Utils.hs ===================================== @@ -57,7 +57,7 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Misc import GHC.Types.Basic ( TopLevelFlag(..), Origin(Generated) ) -import GHC.Data.List.SetOps ( removeDups ) +import GHC.Data.List.SetOps ( removeDupsOn ) import GHC.Data.Maybe ( whenIsJust ) import GHC.Driver.Session import GHC.Data.FastString @@ -114,14 +114,14 @@ checkDupRdrNames :: [LocatedN RdrName] -> RnM () checkDupRdrNames rdr_names_w_loc = mapM_ (dupNamesErr getLocA) dups where - (_, dups) = removeDups (\n1 n2 -> unLoc n1 `compare` unLoc n2) rdr_names_w_loc + (_, dups) = removeDupsOn unLoc rdr_names_w_loc checkDupRdrNamesN :: [LocatedN RdrName] -> RnM () -- Check for duplicated names in a binding group checkDupRdrNamesN rdr_names_w_loc = mapM_ (dupNamesErr getLocA) dups where - (_, dups) = removeDups (\n1 n2 -> unLoc n1 `compare` unLoc n2) rdr_names_w_loc + (_, dups) = removeDupsOn unLoc rdr_names_w_loc checkDupNames :: [Name] -> RnM () -- Check for duplicated names in a binding group @@ -132,7 +132,7 @@ check_dup_names :: [Name] -> RnM () check_dup_names names = mapM_ (dupNamesErr nameSrcSpan) dups where - (_, dups) = removeDups (\n1 n2 -> nameOccName n1 `compare` nameOccName n2) names + (_, dups) = removeDupsOn nameOccName names --------------------- checkShadowedRdrNames :: [LocatedN RdrName] -> RnM () ===================================== compiler/GHC/Stg/Lift/Monad.hs ===================================== @@ -275,15 +275,13 @@ withSubstBndrs = runContT . traverse (ContT . withSubstBndr) -- binder and fresh name generation. withLiftedBndr :: DIdSet -> Id -> (Id -> LiftM a) -> LiftM a withLiftedBndr abs_ids bndr inner = do - uniq <- getUniqueM let str = fsLit "$l" `appendFS` occNameFS (getOccName bndr) let ty = mkLamTypes (dVarSetElems abs_ids) (idType bndr) - let bndr' + bndr' <- -- See Note [transferPolyIdInfo] in GHC.Types.Id. We need to do this at least -- for arity information. - = transferPolyIdInfo bndr (dVarSetElems abs_ids) - . mkSysLocal str uniq ManyTy - $ ty + transferPolyIdInfo bndr (dVarSetElems abs_ids) + <$> mkSysLocalM str ManyTy ty LiftM $ RWS.local (\e -> e { e_subst = extendSubst bndr bndr' $ extendInScope bndr' $ e_subst e ===================================== compiler/GHC/SysTools/Terminal.hs ===================================== @@ -5,6 +5,7 @@ module GHC.SysTools.Terminal (stderrSupportsAnsiColors) where import GHC.Prelude #if !defined(mingw32_HOST_OS) +import System.Environment (lookupEnv) import System.IO (hIsTerminalDevice, stderr) #else import GHC.IO (catchException) @@ -36,8 +37,10 @@ stderrSupportsAnsiColors = unsafePerformIO stderrSupportsAnsiColors' stderrSupportsAnsiColors' :: IO Bool stderrSupportsAnsiColors' = do #if !defined(mingw32_HOST_OS) - -- Coloured text is a part of ANSI standard, no reason to query terminfo - hIsTerminalDevice stderr + -- Equivalent of https://hackage.haskell.org/package/ansi-terminal/docs/System-Console-ANSI.html#v:hSupportsANSI + isTerminal <- hIsTerminalDevice stderr + term <- lookupEnv "TERM" + pure $ isTerminal && term /= Just "dumb" #else h <- Win32.getStdHandle Win32.sTD_ERROR_HANDLE `catchException` \ (_ :: IOError) -> ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -3692,14 +3692,13 @@ splitTyConKind :: SkolemInfo -- See also Note [Datatype return kinds] in GHC.Tc.TyCl splitTyConKind skol_info in_scope avoid_occs kind = do { loc <- getSrcSpanM - ; uniqs <- newUniqueSupply + ; new_uniqs <- getUniquesM ; rdr_env <- getLocalRdrEnv ; lvl <- getTcLevel ; let new_occs = Inf.filter (\ occ -> isNothing (lookupLocalRdrOcc rdr_env occ) && -- Note [Avoid name clashes for associated data types] not (occ `elem` avoid_occs)) $ mkOccName tvName <$> allNameStrings - new_uniqs = uniqsFromSupply uniqs subst = mkEmptySubst in_scope details = SkolemTv skol_info (pushTcLevel lvl) False -- As always, allocate skolems one level in ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -729,9 +729,9 @@ newSysLocalId fs w ty newSysLocalIds :: FastString -> [Scaled TcType] -> TcRnIf gbl lcl [TcId] newSysLocalIds fs tys - = do { us <- newUniqueSupply + = do { us <- getUniquesM ; let mkId' n (Scaled w t) = mkSysLocal fs n w t - ; return (zipWith mkId' (uniqsFromSupply us) tys) } + ; return (zipWith mkId' us tys) } instance MonadUnique (IOEnv (Env gbl lcl)) where getUniqueM = newUnique ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -770,13 +770,11 @@ newMetaTyVarName :: FastString -> TcM Name -- the unifier; see GHC.Tc.Utils.Unify.nicer_to_update_tv1, and -- GHC.Tc.Solver.Canonical.canEqTyVarTyVar (nicer_to_update_tv2) newMetaTyVarName str - = do { uniq <- newUnique - ; return (mkSystemName uniq (mkTyVarOccFS str)) } + = newSysName (mkTyVarOccFS str) cloneMetaTyVarName :: Name -> TcM Name cloneMetaTyVarName name - = do { uniq <- newUnique - ; return (mkSystemName uniq (nameOccName name)) } + = newSysName (nameOccName name) -- See Note [Name of an instantiated type variable] {- Note [Name of an instantiated type variable] ===================================== libraries/base/GHC/Int.hs ===================================== @@ -194,29 +194,29 @@ instance Bits Int8 where {-# INLINE testBit #-} {-# INLINE popCount #-} - (I8# x#) .&. (I8# y#) = I8# (word8ToInt8# (int8ToWord8# x# `andWord8#` int8ToWord8# y#)) - (I8# x#) .|. (I8# y#) = I8# (word8ToInt8# (int8ToWord8# x# `orWord8#` int8ToWord8# y#)) - (I8# x#) `xor` (I8# y#) = I8# (word8ToInt8# (int8ToWord8# x# `xorWord8#` int8ToWord8# y#)) - complement (I8# x#) = I8# (word8ToInt8# (notWord8# (int8ToWord8# x#))) + (I8# x#) .&. (I8# y#) = I8# (intToInt8# ((int8ToInt# x#) `andI#` (int8ToInt# y#))) + (I8# x#) .|. (I8# y#) = I8# (intToInt8# ((int8ToInt# x#) `orI#` (int8ToInt# y#))) + (I8# x#) `xor` (I8# y#) = I8# (intToInt8# ((int8ToInt# x#) `xorI#` (int8ToInt# y#))) + complement (I8# x#) = I8# (intToInt8# (notI# (int8ToInt# x#))) (I8# x#) `shift` (I# i#) - | isTrue# (i# >=# 0#) = I8# (x# `shiftLInt8#` i#) - | otherwise = I8# (x# `shiftRAInt8#` negateInt# i#) + | isTrue# (i# >=# 0#) = I8# (intToInt8# ((int8ToInt# x#) `iShiftL#` i#)) + | otherwise = I8# (intToInt8# ((int8ToInt# x#) `iShiftRA#` negateInt# i#)) (I8# x#) `shiftL` (I# i#) - | isTrue# (i# >=# 0#) = I8# (x# `shiftLInt8#` i#) + | isTrue# (i# >=# 0#) = I8# (intToInt8# ((int8ToInt# x#) `iShiftL#` i#)) | otherwise = overflowError - (I8# x#) `unsafeShiftL` (I# i#) = I8# (x# `uncheckedShiftLInt8#` i#) + (I8# x#) `unsafeShiftL` (I# i#) = I8# (intToInt8# ((int8ToInt# x#) `uncheckedIShiftL#` i#)) (I8# x#) `shiftR` (I# i#) - | isTrue# (i# >=# 0#) = I8# (x# `shiftRAInt8#` i#) + | isTrue# (i# >=# 0#) = I8# (intToInt8# ((int8ToInt# x#) `iShiftRA#` i#)) | otherwise = overflowError - (I8# x#) `unsafeShiftR` (I# i#) = I8# (x# `uncheckedShiftRAInt8#` i#) + (I8# x#) `unsafeShiftR` (I# i#) = I8# (intToInt8# ((int8ToInt# x#) `uncheckedIShiftRA#` i#)) (I8# x#) `rotate` (I# i#) | isTrue# (i'# ==# 0#) = I8# x# | otherwise - = I8# (word8ToInt8# ((x'# `uncheckedShiftLWord8#` i'#) `orWord8#` - (x'# `uncheckedShiftRLWord8#` (8# -# i'#)))) + = I8# (intToInt8# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#` + (x'# `uncheckedShiftRL#` (8# -# i'#))))) where - !x'# = int8ToWord8# x# + !x'# = narrow8Word# (int2Word# (int8ToInt# x#)) !i'# = word2Int# (int2Word# i# `and#` 7##) bitSizeMaybe i = Just (finiteBitSize i) bitSize i = finiteBitSize i @@ -405,29 +405,29 @@ instance Bits Int16 where {-# INLINE testBit #-} {-# INLINE popCount #-} - (I16# x#) .&. (I16# y#) = I16# (word16ToInt16# (int16ToWord16# x# `andWord16#` int16ToWord16# y#)) - (I16# x#) .|. (I16# y#) = I16# (word16ToInt16# (int16ToWord16# x# `orWord16#` int16ToWord16# y#)) - (I16# x#) `xor` (I16# y#) = I16# (word16ToInt16# (int16ToWord16# x# `xorWord16#` int16ToWord16# y#)) - complement (I16# x#) = I16# (word16ToInt16# (notWord16# (int16ToWord16# x#))) + (I16# x#) .&. (I16# y#) = I16# (intToInt16# ((int16ToInt# x#) `andI#` (int16ToInt# y#))) + (I16# x#) .|. (I16# y#) = I16# (intToInt16# ((int16ToInt# x#) `orI#` (int16ToInt# y#))) + (I16# x#) `xor` (I16# y#) = I16# (intToInt16# ((int16ToInt# x#) `xorI#` (int16ToInt# y#))) + complement (I16# x#) = I16# (intToInt16# (notI# (int16ToInt# x#))) (I16# x#) `shift` (I# i#) - | isTrue# (i# >=# 0#) = I16# (x# `shiftLInt16#` i#) - | otherwise = I16# (x# `shiftRAInt16#` negateInt# i#) + | isTrue# (i# >=# 0#) = I16# (intToInt16# ((int16ToInt# x#) `iShiftL#` i#)) + | otherwise = I16# (intToInt16# ((int16ToInt# x#) `iShiftRA#` negateInt# i#)) (I16# x#) `shiftL` (I# i#) - | isTrue# (i# >=# 0#) = I16# (x# `shiftLInt16#` i#) + | isTrue# (i# >=# 0#) = I16# (intToInt16# ((int16ToInt# x#) `iShiftL#` i#)) | otherwise = overflowError - (I16# x#) `unsafeShiftL` (I# i#) = I16# (x# `uncheckedShiftLInt16#` i#) + (I16# x#) `unsafeShiftL` (I# i#) = I16# (intToInt16# ((int16ToInt# x#) `uncheckedIShiftL#` i#)) (I16# x#) `shiftR` (I# i#) - | isTrue# (i# >=# 0#) = I16# (x# `shiftRAInt16#` i#) + | isTrue# (i# >=# 0#) = I16# (intToInt16# ((int16ToInt# x#) `iShiftRA#` i#)) | otherwise = overflowError - (I16# x#) `unsafeShiftR` (I# i#) = I16# (x# `uncheckedShiftRAInt16#` i#) + (I16# x#) `unsafeShiftR` (I# i#) = I16# (intToInt16# ((int16ToInt# x#) `uncheckedIShiftRA#` i#)) (I16# x#) `rotate` (I# i#) | isTrue# (i'# ==# 0#) = I16# x# | otherwise - = I16# (word16ToInt16# ((x'# `uncheckedShiftLWord16#` i'#) `orWord16#` - (x'# `uncheckedShiftRLWord16#` (16# -# i'#)))) + = I16# (intToInt16# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#` + (x'# `uncheckedShiftRL#` (16# -# i'#))))) where - !x'# = int16ToWord16# x# + !x'# = narrow16Word# (int2Word# (int16ToInt# x#)) !i'# = word2Int# (int2Word# i# `and#` 15##) bitSizeMaybe i = Just (finiteBitSize i) bitSize i = finiteBitSize i @@ -607,25 +607,25 @@ instance Bits Int32 where (I32# x#) `xor` (I32# y#) = I32# (intToInt32# ((int32ToInt# x#) `xorI#` (int32ToInt# y#))) complement (I32# x#) = I32# (intToInt32# (notI# (int32ToInt# x#))) (I32# x#) `shift` (I# i#) - | isTrue# (i# >=# 0#) = I32# (x# `shiftLInt32#` i#) - | otherwise = I32# (x# `shiftRAInt32#` negateInt# i#) + | isTrue# (i# >=# 0#) = I32# (intToInt32# ((int32ToInt# x#) `iShiftL#` i#)) + | otherwise = I32# (intToInt32# ((int32ToInt# x#) `iShiftRA#` negateInt# i#)) (I32# x#) `shiftL` (I# i#) - | isTrue# (i# >=# 0#) = I32# (x# `shiftLInt32#` i#) + | isTrue# (i# >=# 0#) = I32# (intToInt32# ((int32ToInt# x#) `iShiftL#` i#)) | otherwise = overflowError (I32# x#) `unsafeShiftL` (I# i#) = - I32# (x# `uncheckedShiftLInt32#` i#) + I32# (intToInt32# ((int32ToInt# x#) `uncheckedIShiftL#` i#)) (I32# x#) `shiftR` (I# i#) - | isTrue# (i# >=# 0#) = I32# (x# `shiftRAInt32#` i#) + | isTrue# (i# >=# 0#) = I32# (intToInt32# ((int32ToInt# x#) `iShiftRA#` i#)) | otherwise = overflowError - (I32# x#) `unsafeShiftR` (I# i#) = I32# (x# `uncheckedShiftRAInt32#` i#) + (I32# x#) `unsafeShiftR` (I# i#) = I32# (intToInt32# ((int32ToInt# x#) `uncheckedIShiftRA#` i#)) (I32# x#) `rotate` (I# i#) | isTrue# (i'# ==# 0#) = I32# x# | otherwise - = I32# (word32ToInt32# ((x'# `uncheckedShiftLWord32#` i'#) `orWord32#` - (x'# `uncheckedShiftRLWord32#` (32# -# i'#)))) + = I32# (intToInt32# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#` + (x'# `uncheckedShiftRL#` (32# -# i'#))))) where - !x'# = int32ToWord32# x# + !x'# = narrow32Word# (int2Word# (int32ToInt# x#)) !i'# = word2Int# (int2Word# i# `and#` 31##) bitSizeMaybe i = Just (finiteBitSize i) bitSize i = finiteBitSize i @@ -1095,31 +1095,10 @@ a `shiftRLInt32#` b = uncheckedShiftRLInt32# a b `andInt32#` intToInt32# (shift_ -shiftLInt8# :: Int8# -> Int# -> Int8# -a `shiftLInt8#` b = uncheckedShiftLInt8# a b `andInt8#` intToInt8# (shift_mask 8# b) - -shiftLInt16# :: Int16# -> Int# -> Int16# -a `shiftLInt16#` b = uncheckedShiftLInt16# a b `andInt16#` intToInt16# (shift_mask 16# b) - -shiftLInt32# :: Int32# -> Int# -> Int32# -a `shiftLInt32#` b = uncheckedShiftLInt32# a b `andInt32#` intToInt32# (shift_mask 32# b) - shiftLInt64# :: Int64# -> Int# -> Int64# a `shiftLInt64#` b = uncheckedIShiftL64# a b `andInt64#` intToInt64# (shift_mask 64# b) -shiftRAInt8# :: Int8# -> Int# -> Int8# -a `shiftRAInt8#` b | isTrue# (b >=# 8#) = intToInt8# (negateInt# (a `ltInt8#` (intToInt8# 0#))) - | otherwise = a `uncheckedShiftRAInt8#` b - -shiftRAInt16# :: Int16# -> Int# -> Int16# -a `shiftRAInt16#` b | isTrue# (b >=# 16#) = intToInt16# (negateInt# (a `ltInt16#` (intToInt16# 0#))) - | otherwise = a `uncheckedShiftRAInt16#` b - -shiftRAInt32# :: Int32# -> Int# -> Int32# -a `shiftRAInt32#` b | isTrue# (b >=# 32#) = intToInt32# (negateInt# (a `ltInt32#` (intToInt32# 0#))) - | otherwise = a `uncheckedShiftRAInt32#` b - shiftRAInt64# :: Int64# -> Int# -> Int64# a `shiftRAInt64#` b | isTrue# (b >=# 64#) = intToInt64# (negateInt# (a `ltInt64#` (intToInt64# 0#))) | otherwise = a `uncheckedIShiftRA64#` b ===================================== libraries/base/GHC/Word.hs ===================================== @@ -184,26 +184,26 @@ instance Bits Word8 where {-# INLINE testBit #-} {-# INLINE popCount #-} - (W8# x#) .&. (W8# y#) = W8# (x# `andWord8#` y#) - (W8# x#) .|. (W8# y#) = W8# (x# `orWord8#` y#) - (W8# x#) `xor` (W8# y#) = W8# (x# `xorWord8#` y#) - complement (W8# x#) = W8# (notWord8# x#) + (W8# x#) .&. (W8# y#) = W8# (wordToWord8# ((word8ToWord# x#) `and#` (word8ToWord# y#))) + (W8# x#) .|. (W8# y#) = W8# (wordToWord8# ((word8ToWord# x#) `or#` (word8ToWord# y#))) + (W8# x#) `xor` (W8# y#) = W8# (wordToWord8# ((word8ToWord# x#) `xor#` (word8ToWord# y#))) + complement (W8# x#) = W8# (wordToWord8# (not# (word8ToWord# x#))) (W8# x#) `shift` (I# i#) - | isTrue# (i# >=# 0#) = W8# (x# `shiftLWord8#` i#) - | otherwise = W8# (x# `shiftRLWord8#` negateInt# i#) + | isTrue# (i# >=# 0#) = W8# (wordToWord8# ((word8ToWord# x#) `shiftL#` i#)) + | otherwise = W8# (wordToWord8# ((word8ToWord# x#) `shiftRL#` negateInt# i#)) (W8# x#) `shiftL` (I# i#) - | isTrue# (i# >=# 0#) = W8# (x# `shiftLWord8#` i#) + | isTrue# (i# >=# 0#) = W8# (wordToWord8# ((word8ToWord# x#) `shiftL#` i#)) | otherwise = overflowError (W8# x#) `unsafeShiftL` (I# i#) = - W8# (x# `uncheckedShiftLWord8#` i#) + W8# (wordToWord8# ((word8ToWord# x#) `uncheckedShiftL#` i#)) (W8# x#) `shiftR` (I# i#) - | isTrue# (i# >=# 0#) = W8# (x# `shiftRLWord8#` i#) + | isTrue# (i# >=# 0#) = W8# (wordToWord8# ((word8ToWord# x#) `shiftRL#` i#)) | otherwise = overflowError - (W8# x#) `unsafeShiftR` (I# i#) = W8# (x# `uncheckedShiftRLWord8#` i#) + (W8# x#) `unsafeShiftR` (I# i#) = W8# (wordToWord8# ((word8ToWord# x#) `uncheckedShiftRL#` i#)) (W8# x#) `rotate` (I# i#) | isTrue# (i'# ==# 0#) = W8# x# - | otherwise = W8# ((x# `uncheckedShiftLWord8#` i'#) `orWord8#` - (x# `uncheckedShiftRLWord8#` (8# -# i'#))) + | otherwise = W8# (wordToWord8# (((word8ToWord# x#) `uncheckedShiftL#` i'#) `or#` + ((word8ToWord# x#) `uncheckedShiftRL#` (8# -# i'#)))) where !i'# = word2Int# (int2Word# i# `and#` 7##) bitSizeMaybe i = Just (finiteBitSize i) @@ -374,26 +374,26 @@ instance Bits Word16 where {-# INLINE testBit #-} {-# INLINE popCount #-} - (W16# x#) .&. (W16# y#) = W16# (x# `andWord16#` y#) - (W16# x#) .|. (W16# y#) = W16# (x# `orWord16#` y#) - (W16# x#) `xor` (W16# y#) = W16# (x# `xorWord16#` y#) - complement (W16# x#) = W16# (notWord16# x#) + (W16# x#) .&. (W16# y#) = W16# (wordToWord16# ((word16ToWord# x#) `and#` (word16ToWord# y#))) + (W16# x#) .|. (W16# y#) = W16# (wordToWord16# ((word16ToWord# x#) `or#` (word16ToWord# y#))) + (W16# x#) `xor` (W16# y#) = W16# (wordToWord16# ((word16ToWord# x#) `xor#` (word16ToWord# y#))) + complement (W16# x#) = W16# (wordToWord16# (not# (word16ToWord# x#))) (W16# x#) `shift` (I# i#) - | isTrue# (i# >=# 0#) = W16# (x# `shiftLWord16#` i#) - | otherwise = W16# (x# `shiftRLWord16#` negateInt# i#) + | isTrue# (i# >=# 0#) = W16# (wordToWord16# ((word16ToWord# x#) `shiftL#` i#)) + | otherwise = W16# (wordToWord16# ((word16ToWord# x#) `shiftRL#` negateInt# i#)) (W16# x#) `shiftL` (I# i#) - | isTrue# (i# >=# 0#) = W16# (x# `shiftLWord16#` i#) + | isTrue# (i# >=# 0#) = W16# (wordToWord16# ((word16ToWord# x#) `shiftL#` i#)) | otherwise = overflowError (W16# x#) `unsafeShiftL` (I# i#) = - W16# (x# `uncheckedShiftLWord16#` i#) + W16# (wordToWord16# ((word16ToWord# x#) `uncheckedShiftL#` i#)) (W16# x#) `shiftR` (I# i#) - | isTrue# (i# >=# 0#) = W16# (x# `shiftRLWord16#` i#) + | isTrue# (i# >=# 0#) = W16# (wordToWord16# ((word16ToWord# x#) `shiftRL#` i#)) | otherwise = overflowError - (W16# x#) `unsafeShiftR` (I# i#) = W16# (x# `uncheckedShiftRLWord16#` i#) + (W16# x#) `unsafeShiftR` (I# i#) = W16# (wordToWord16# ((word16ToWord# x#) `uncheckedShiftRL#` i#)) (W16# x#) `rotate` (I# i#) | isTrue# (i'# ==# 0#) = W16# x# - | otherwise = W16# ((x# `uncheckedShiftLWord16#` i'#) `orWord16#` - (x# `uncheckedShiftRLWord16#` (16# -# i'#))) + | otherwise = W16# (wordToWord16# (((word16ToWord# x#) `uncheckedShiftL#` i'#) `or#` + ((word16ToWord# x#) `uncheckedShiftRL#` (16# -# i'#)))) where !i'# = word2Int# (int2Word# i# `and#` 15##) bitSizeMaybe i = Just (finiteBitSize i) @@ -601,26 +601,26 @@ instance Bits Word32 where {-# INLINE testBit #-} {-# INLINE popCount #-} - (W32# x#) .&. (W32# y#) = W32# (x# `andWord32#` y#) - (W32# x#) .|. (W32# y#) = W32# (x# `orWord32#` y#) - (W32# x#) `xor` (W32# y#) = W32# (x# `xorWord32#` y#) - complement (W32# x#) = W32# (notWord32# x#) + (W32# x#) .&. (W32# y#) = W32# (wordToWord32# ((word32ToWord# x#) `and#` (word32ToWord# y#))) + (W32# x#) .|. (W32# y#) = W32# (wordToWord32# ((word32ToWord# x#) `or#` (word32ToWord# y#))) + (W32# x#) `xor` (W32# y#) = W32# (wordToWord32# ((word32ToWord# x#) `xor#` (word32ToWord# y#))) + complement (W32# x#) = W32# (wordToWord32# (not# (word32ToWord# x#))) (W32# x#) `shift` (I# i#) - | isTrue# (i# >=# 0#) = W32# (x# `shiftLWord32#` i#) - | otherwise = W32# (x# `shiftRLWord32#` negateInt# i#) + | isTrue# (i# >=# 0#) = W32# (wordToWord32# ((word32ToWord# x#) `shiftL#` i#)) + | otherwise = W32# (wordToWord32# ((word32ToWord# x#) `shiftRL#` negateInt# i#)) (W32# x#) `shiftL` (I# i#) - | isTrue# (i# >=# 0#) = W32# (x# `shiftLWord32#` i#) + | isTrue# (i# >=# 0#) = W32# (wordToWord32# ((word32ToWord# x#) `shiftL#` i#)) | otherwise = overflowError (W32# x#) `unsafeShiftL` (I# i#) = - W32# (x# `uncheckedShiftLWord32#` i#) + W32# (wordToWord32# ((word32ToWord# x#) `uncheckedShiftL#` i#)) (W32# x#) `shiftR` (I# i#) - | isTrue# (i# >=# 0#) = W32# (x# `shiftRLWord32#` i#) + | isTrue# (i# >=# 0#) = W32# (wordToWord32# ((word32ToWord# x#) `shiftRL#` i#)) | otherwise = overflowError - (W32# x#) `unsafeShiftR` (I# i#) = W32# (x# `uncheckedShiftRLWord32#` i#) + (W32# x#) `unsafeShiftR` (I# i#) = W32# (wordToWord32# ((word32ToWord# x#) `uncheckedShiftRL#` i#)) (W32# x#) `rotate` (I# i#) | isTrue# (i'# ==# 0#) = W32# x# - | otherwise = W32# ((x# `uncheckedShiftLWord32#` i'#) `orWord32#` - (x# `uncheckedShiftRLWord32#` (32# -# i'#))) + | otherwise = W32# (wordToWord32# (((word32ToWord# x#) `uncheckedShiftL#` i'#) `or#` + ((word32ToWord# x#) `uncheckedShiftRL#` (32# -# i'#)))) where !i'# = word2Int# (int2Word# i# `and#` 31##) bitSizeMaybe i = Just (finiteBitSize i) @@ -894,34 +894,10 @@ bitReverse64 (W64# w#) = W64# (bitReverse64# w#) -- The following safe shift operations wrap unchecked primops to take this into -- account: 0 is consistently returned when the shift amount is too big. -shiftRLWord8# :: Word8# -> Int# -> Word8# -a `shiftRLWord8#` b = uncheckedShiftRLWord8# a b - `andWord8#` wordToWord8# (int2Word# (shift_mask 8# b)) - -shiftRLWord16# :: Word16# -> Int# -> Word16# -a `shiftRLWord16#` b = uncheckedShiftRLWord16# a b - `andWord16#` wordToWord16# (int2Word# (shift_mask 16# b)) - -shiftRLWord32# :: Word32# -> Int# -> Word32# -a `shiftRLWord32#` b = uncheckedShiftRLWord32# a b - `andWord32#` wordToWord32# (int2Word# (shift_mask 32# b)) - shiftRLWord64# :: Word64# -> Int# -> Word64# a `shiftRLWord64#` b = uncheckedShiftRL64# a b `and64#` int64ToWord64# (intToInt64# (shift_mask 64# b)) -shiftLWord8# :: Word8# -> Int# -> Word8# -a `shiftLWord8#` b = uncheckedShiftLWord8# a b - `andWord8#` wordToWord8# (int2Word# (shift_mask 8# b)) - -shiftLWord16# :: Word16# -> Int# -> Word16# -a `shiftLWord16#` b = uncheckedShiftLWord16# a b - `andWord16#` wordToWord16# (int2Word# (shift_mask 16# b)) - -shiftLWord32# :: Word32# -> Int# -> Word32# -a `shiftLWord32#` b = uncheckedShiftLWord32# a b - `andWord32#` wordToWord32# (int2Word# (shift_mask 32# b)) - shiftLWord64# :: Word64# -> Int# -> Word64# a `shiftLWord64#` b = uncheckedShiftL64# a b `and64#` int64ToWord64# (intToInt64# (shift_mask 64# b)) ===================================== libraries/base/changelog.md ===================================== @@ -1,5 +1,10 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) +## 4.19.0.0 *TBA* + * 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. + ## 4.18.0.0 *TBA* * `Foreign.C.ConstPtr.ConstrPtr` was added to encode `const`-qualified pointer types in foreign declarations when using `CApiFFI` extension. ([CLC proposal #117](https://github.com/haskell/core-libraries-committee/issues/117)) @@ -63,9 +68,6 @@ * Add `Data.Typeable.heqT`, a kind-heterogeneous version of `Data.Typeable.eqT` ([CLC proposal #99](https://github.com/haskell/core-libraries-committee/issues/99)) - * 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. ## 4.17.0.0 *August 2022* ===================================== testsuite/tests/simplCore/should_run/T20203.stderr-ws-32 ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 290, types: 141, coercions: 0, joins: 0/0} + = {terms: 340, types: 140, coercions: 0, joins: 0/0} bitOrTwoVarInt = \ x y -> @@ -24,33 +24,50 @@ bitOrTwoVarInt8 case x of { I8# x# -> case y of { I8# x#1 -> I8# - (word8ToInt8# - (orWord8# 17#Word8 (orWord8# (int8ToWord8# x#) (int8ToWord8# x#1)))) + (intToInt8# + (orI# + (int8ToInt# (intToInt8# (orI# (int8ToInt# x#) 1#))) + (int8ToInt# (intToInt8# (orI# (int8ToInt# x#1) 16#))))) } } -bitAndInt1 = I8# 0#Int8 - bitAndTwoVarInt8 = \ x y -> - case x of { I8# x# -> case y of { I8# x#1 -> bitAndInt1 } } + case x of { I8# x# -> + case y of { I8# x#1 -> + I8# + (intToInt8# + (andI# + (int8ToInt# (intToInt8# (andI# (int8ToInt# x#) 1#))) + (int8ToInt# (intToInt8# (andI# (int8ToInt# x#1) 16#))))) + } + } bitOrInt8 = \ x -> case x of { I8# x# -> - I8# (word8ToInt8# (orWord8# 17#Word8 (int8ToWord8# x#))) + I8# + (intToInt8# + (orI# (int8ToInt# (intToInt8# (orI# (int8ToInt# x#) 1#))) 16#)) } -bitAndInt8 = \ x -> case x of { I8# x# -> bitAndInt1 } +bitAndInt8 + = / x -> + case x of { I8# x# -> + I8# + (intToInt8# + (andI# (int8ToInt# (intToInt8# (andI# (int8ToInt# x#) 1#))) 16#)) + } bitOrTwoVarInt16 = \ x y -> case x of { I16# x# -> case y of { I16# x#1 -> I16# - (word16ToInt16# - (orWord16# - 255#Word16 (orWord16# (int16ToWord16# x#) (int16ToWord16# x#1)))) + (intToInt16# + (orI# + (int16ToInt# (intToInt16# (orI# (int16ToInt# x#) 250#))) + (int16ToInt# (intToInt16# (orI# (int16ToInt# x#1) 175#))))) } } @@ -59,22 +76,28 @@ bitAndTwoVarInt16 case x of { I16# x# -> case y of { I16# x#1 -> I16# - (word16ToInt16# - (andWord16# - 170#Word16 (andWord16# (int16ToWord16# x#) (int16ToWord16# x#1)))) - } + (intToInt16# + (andI# + (int16ToInt# (intToInt16# (andI# (int16ToInt# x#) 250#))) + (int16ToInt# (intToInt16# (andI# (int16ToInt# x#1) 175#))))) } } bitOrInt16 = \ x -> case x of { I16# x# -> - I16# (word16ToInt16# (orWord16# 255#Word16 (int16ToWord16# x#))) + I16# + (intToInt16# + (orI# + (int16ToInt# (intToInt16# (orI# (int16ToInt# x#) 250#))) 175#)) } bitAndInt16 = \ x -> case x of { I16# x# -> - I16# (word16ToInt16# (andWord16# 170#Word16 (int16ToWord16# x#))) + I16# + (intToInt16# + (andI# + (int16ToInt# (intToInt16# (andI# (int16ToInt# x#) 250#))) 175#)) } bitOrTwoVarInt32 @@ -125,7 +148,7 @@ bitOrTwoVarInt64 case y of { I64# x#1 -> I64# (word64ToInt64# - (or64# 255#Word64 (or64# (int64ToWord64# x#) (int64ToWord64# x#1)))) + (or64# 255#Word64 (or64# (int64ToWord64# x#) (int64ToWord64# x#1)))) } } @@ -135,7 +158,7 @@ bitAndTwoVarInt64 case y of { I64# x#1 -> I64# (word64ToInt64# - (and64# 170#Word64 (and64# (int64ToWord64# x#) (int64ToWord64# x#1)))) + (and64# 170#Word64 (and64# (int64ToWord64# x#) (int64ToWord64# x#1)))) } } @@ -144,7 +167,7 @@ bitOrInt64 case x of { I64# x# -> I64# (word64ToInt64# (or64# 255#Word64 (int64ToWord64# x#))) } - + bitAndInt64 = / x -> case x of { I64# x# -> ===================================== testsuite/tests/simplCore/should_run/T20203.stderr-ws-64 ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 290, types: 141, coercions: 0, joins: 0/0} + = {terms: 340, types: 140, coercions: 0, joins: 0/0} bitOrTwoVarInt = \ x y -> @@ -24,34 +24,50 @@ bitOrTwoVarInt8 case x of { I8# x# -> case y of { I8# x#1 -> I8# - (word8ToInt8# - (orWord8# - 17#Word8 (orWord8# (int8ToWord8# x#) (int8ToWord8# x#1)))) + (intToInt8# + (orI# + (int8ToInt# (intToInt8# (orI# (int8ToInt# x#) 1#))) + (int8ToInt# (intToInt8# (orI# (int8ToInt# x#1) 16#))))) } } -bitAndInt1 = I8# 0#Int8 - bitAndTwoVarInt8 = \ x y -> - case x of { I8# x# -> case y of { I8# x#1 -> bitAndInt1 } } + case x of { I8# x# -> + case y of { I8# x#1 -> + I8# + (intToInt8# + (andI# + (int8ToInt# (intToInt8# (andI# (int8ToInt# x#) 1#))) + (int8ToInt# (intToInt8# (andI# (int8ToInt# x#1) 16#))))) + } + } bitOrInt8 = \ x -> case x of { I8# x# -> - I8# (word8ToInt8# (orWord8# 17#Word8 (int8ToWord8# x#))) + I8# + (intToInt8# + (orI# (int8ToInt# (intToInt8# (orI# (int8ToInt# x#) 1#))) 16#)) } -bitAndInt8 = \ x -> case x of { I8# x# -> bitAndInt1 } +bitAndInt8 + = \ x -> + case x of { I8# x# -> + I8# + (intToInt8# + (andI# (int8ToInt# (intToInt8# (andI# (int8ToInt# x#) 1#))) 16#)) + } bitOrTwoVarInt16 = \ x y -> case x of { I16# x# -> case y of { I16# x#1 -> I16# - (word16ToInt16# - (orWord16# - 255#Word16 (orWord16# (int16ToWord16# x#) (int16ToWord16# x#1)))) + (intToInt16# + (orI# + (int16ToInt# (intToInt16# (orI# (int16ToInt# x#) 250#))) + (int16ToInt# (intToInt16# (orI# (int16ToInt# x#1) 175#))))) } } @@ -60,22 +76,29 @@ bitAndTwoVarInt16 case x of { I16# x# -> case y of { I16# x#1 -> I16# - (word16ToInt16# - (andWord16# - 170#Word16 (andWord16# (int16ToWord16# x#) (int16ToWord16# x#1)))) + (intToInt16# + (andI# + (int16ToInt# (intToInt16# (andI# (int16ToInt# x#) 250#))) + (int16ToInt# (intToInt16# (andI# (int16ToInt# x#1) 175#))))) } } bitOrInt16 = \ x -> case x of { I16# x# -> - I16# (word16ToInt16# (orWord16# 255#Word16 (int16ToWord16# x#))) + I16# + (intToInt16# + (orI# + (int16ToInt# (intToInt16# (orI# (int16ToInt# x#) 250#))) 175#)) } bitAndInt16 = \ x -> case x of { I16# x# -> - I16# (word16ToInt16# (andWord16# 170#Word16 (int16ToWord16# x#))) + I16# + (intToInt16# + (andI# + (int16ToInt# (intToInt16# (andI# (int16ToInt# x#) 250#))) 175#)) } bitOrTwoVarInt32 ===================================== utils/ghc-pkg/Main.hs ===================================== @@ -86,6 +86,7 @@ import qualified Data.ByteString as BS #if defined(mingw32_HOST_OS) import GHC.ConsoleHandler #else +import System.Environment (lookupEnv) import System.Posix hiding (fdToHandle) #endif @@ -1591,8 +1592,9 @@ listPackages verbosity my_flags mPackageName mModuleName = do pkg = display (mungedId p) is_tty <- hIsTerminalDevice stdout - -- Coloured text is a part of ANSI standard, no reason to query terminfo - mapM_ (if is_tty then show_colour else show_normal) stack + -- Equivalent of https://hackage.haskell.org/package/ansi-terminal/docs/System-Console-ANSI.html#v:hSupportsANSI + term <- lookupEnv "TERM" + mapM_ (if is_tty && term /= Just "dumb" then show_colour else show_normal) stack #endif simplePackageList :: [Flag] -> [InstalledPackageInfo] -> IO () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8d95d06c6c23a2577416fdff4ad0e6bc07916437...35b15d67e762520818b5983a2fabd92477bb776e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8d95d06c6c23a2577416fdff4ad0e6bc07916437...35b15d67e762520818b5983a2fabd92477bb776e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Feb 4 23:48:48 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 04 Feb 2023 18:48:48 -0500 Subject: [Git][ghc/ghc][master] Fix colors in emacs terminal Message-ID: <63deeee0dab0c_1108fe526208835b@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 2 changed files: - compiler/GHC/SysTools/Terminal.hs - utils/ghc-pkg/Main.hs Changes: ===================================== compiler/GHC/SysTools/Terminal.hs ===================================== @@ -5,6 +5,7 @@ module GHC.SysTools.Terminal (stderrSupportsAnsiColors) where import GHC.Prelude #if !defined(mingw32_HOST_OS) +import System.Environment (lookupEnv) import System.IO (hIsTerminalDevice, stderr) #else import GHC.IO (catchException) @@ -36,8 +37,10 @@ stderrSupportsAnsiColors = unsafePerformIO stderrSupportsAnsiColors' stderrSupportsAnsiColors' :: IO Bool stderrSupportsAnsiColors' = do #if !defined(mingw32_HOST_OS) - -- Coloured text is a part of ANSI standard, no reason to query terminfo - hIsTerminalDevice stderr + -- Equivalent of https://hackage.haskell.org/package/ansi-terminal/docs/System-Console-ANSI.html#v:hSupportsANSI + isTerminal <- hIsTerminalDevice stderr + term <- lookupEnv "TERM" + pure $ isTerminal && term /= Just "dumb" #else h <- Win32.getStdHandle Win32.sTD_ERROR_HANDLE `catchException` \ (_ :: IOError) -> ===================================== utils/ghc-pkg/Main.hs ===================================== @@ -86,6 +86,7 @@ import qualified Data.ByteString as BS #if defined(mingw32_HOST_OS) import GHC.ConsoleHandler #else +import System.Environment (lookupEnv) import System.Posix hiding (fdToHandle) #endif @@ -1591,8 +1592,9 @@ listPackages verbosity my_flags mPackageName mModuleName = do pkg = display (mungedId p) is_tty <- hIsTerminalDevice stdout - -- Coloured text is a part of ANSI standard, no reason to query terminfo - mapM_ (if is_tty then show_colour else show_normal) stack + -- Equivalent of https://hackage.haskell.org/package/ansi-terminal/docs/System-Console-ANSI.html#v:hSupportsANSI + term <- lookupEnv "TERM" + mapM_ (if is_tty && term /= Just "dumb" then show_colour else show_normal) stack #endif simplePackageList :: [Flag] -> [InstalledPackageInfo] -> IO () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5a54ac0b2b915889950c83e04bf1beb08631891e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5a54ac0b2b915889950c83e04bf1beb08631891e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Feb 4 23:49:27 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 04 Feb 2023 18:49:27 -0500 Subject: [Git][ghc/ghc][master] base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section Message-ID: <63deef077e90e_1108fe526848868f0@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - 1 changed file: - libraries/base/changelog.md Changes: ===================================== libraries/base/changelog.md ===================================== @@ -1,5 +1,10 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) +## 4.19.0.0 *TBA* + * 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. + ## 4.18.0.0 *TBA* * `Foreign.C.ConstPtr.ConstrPtr` was added to encode `const`-qualified pointer types in foreign declarations when using `CApiFFI` extension. ([CLC proposal #117](https://github.com/haskell/core-libraries-committee/issues/117)) @@ -63,9 +68,6 @@ * Add `Data.Typeable.heqT`, a kind-heterogeneous version of `Data.Typeable.eqT` ([CLC proposal #99](https://github.com/haskell/core-libraries-committee/issues/99)) - * 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. ## 4.17.0.0 *August 2022* View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3c0f0c6d99486502c72e6514a40e7264baaa6afc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3c0f0c6d99486502c72e6514a40e7264baaa6afc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Feb 5 08:52:19 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sun, 05 Feb 2023 03:52:19 -0500 Subject: [Git][ghc/ghc][wip/int-index/visibility-check] Apply 4 suggestion(s) to 2 file(s) Message-ID: <63df6e437cd86_1108fec035f0924053@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/visibility-check at Glasgow Haskell Compiler / GHC Commits: 89801d0e by Ryan Scott at 2023-02-05T08:52:16+00:00 Apply 4 suggestion(s) to 2 file(s) - - - - - 2 changed files: - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs Changes: ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1228,7 +1228,7 @@ instance Diagnostic TcRnMessage where 2 (text "thus:" <+> (parens (ppr expr))) TcRnIncompatibleForallVisibility act exp -> mkSimpleDecorated $ - hang (text "Visibility of forall-bound variables is not compatible") 2 $ + hang (text "Visibilities of forall-bound variables are not compatible") 2 $ vcat [ text "Expected:" <+> ppr exp , text " Actual:" <+> ppr act ] @@ -2981,7 +2981,7 @@ pprCannotUnifyVariableReason ctxt (RepresentationalEq tv_info mb_coercible_msg) = pprTyVarInfo ctxt tv_info $$ maybe empty pprCoercibleMsg mb_coercible_msg pprCannotUnifyVariableReason _ (ForallKindVisDiff tv1 ty2) - = hang (text "Visibility of forall-bound variables in kinds differs") 2 $ + = hang (text "Visibilities of forall-bound variables in kinds differ") 2 $ vcat [ ppr tv1 <+> text "::" <+> ppr (tyVarKind tv1) , ppr ty2 <+> text "::" <+> ppr (typeKind ty2) ] ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -2926,7 +2926,7 @@ data TcRnMessage where {-| TcRnIncompatibleForallVisibility is an error that occurs when the expected and actual types contain forall-bound variables - that have incompatible visibility. + that have incompatible visibilities. Example: type family Invis :: Type -> forall a. a @@ -3805,7 +3805,7 @@ data CannotUnifyVariableReason | RepresentationalEq TyVarInfo (Maybe CoercibleMsg) -- | Can't unify a kind-polymorphic type variable with a type - -- due to visibility difference of forall-bound variables in their kinds. + -- due to differences in visibility between forall-bound variables in their kinds. -- -- Example: -- data V k (a :: k) = MkV View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/89801d0ed204d8c80e463aa9f0485cf708b2823b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/89801d0ed204d8c80e463aa9f0485cf708b2823b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Feb 5 14:34:52 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sun, 05 Feb 2023 09:34:52 -0500 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] Fix tests Message-ID: <63dfbe8c9fd4a_1108fe193a7398955683@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: ae0d6694 by Sven Tennie at 2023-02-05T14:34:27+00:00 Fix tests - - - - - 2 changed files: - libraries/ghc-heap/tests/ClosureSizeUtils.hs - libraries/ghc-heap/tests/all.T Changes: ===================================== libraries/ghc-heap/tests/ClosureSizeUtils.hs ===================================== @@ -11,6 +11,7 @@ module ClosureSizeUtils (assertSize, assertSizeUnlifted) where import Control.Monad import GHC.Exts +import GHC.Exts.Heap import GHC.Exts.Heap.Closures import GHC.Stack import Type.Reflection @@ -45,7 +46,7 @@ assertSizeBox -> Int -- ^ expected size in words -> IO () assertSizeBox x ty expected = do - let !size = closureSize x + !size <- closureSize x when (size /= expected') $ do putStrLn $ "closureSize ("++show ty++") == "++show size++", expected "++show expected' putStrLn $ prettyCallStack callStack ===================================== libraries/ghc-heap/tests/all.T ===================================== @@ -39,20 +39,20 @@ test('closure_size_noopt', compile_and_run, ['']) test('tso_and_stack_closures', - [extra_files(['create_tso.c','create_tso.h','TestUtils.hs','stack_lib.c']), + [extra_files(['create_tso.c','create_tso.h','TestUtils.hs']), only_ways(['profthreaded']), ignore_stdout, ignore_stderr ], - multi_compile_and_run, ['tso_and_stack_closures', [('create_tso.c',''), ('stack_lib.c', '')], '']) + multi_compile_and_run, ['tso_and_stack_closures', [('create_tso.c','')], '']) test('parse_tso_flags', - [extra_files(['stack_lib.c', 'TestUtils.hs']), + [extra_files(['TestUtils.hs']), only_ways(['normal']), ignore_stdout, ignore_stderr ], - multi_compile_and_run, ['parse_tso_flags', [('stack_lib.c','')], '']) + compile_and_run, ['']) test('T21622', only_ways(['normal']), compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ae0d6694b68983c7b4b098451e2b59a466ec8cd4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ae0d6694b68983c7b4b098451e2b59a466ec8cd4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Feb 5 16:26:47 2023 From: gitlab at gitlab.haskell.org (Peter Trommler (@trommler)) Date: Sun, 05 Feb 2023 11:26:47 -0500 Subject: [Git][ghc/ghc][wip/T21191] 1449 commits: [ci skip] Drop outdated TODO in RtsAPI.c Message-ID: <63dfd8c76f63d_1108fe5265c96754a@gitlab.mail> Peter Trommler pushed to branch wip/T21191 at Glasgow Haskell Compiler / GHC Commits: 0481a6af by Cheng Shao at 2022-04-21T11:06:06+00:00 [ci skip] Drop outdated TODO in RtsAPI.c - - - - - 1e062a8a by Ben Gamari at 2022-04-22T02:12:59-04:00 rts: Introduce ip_STACK_FRAME While debugging it is very useful to be able to determine whether a given info table is a stack frame or not. We have spare bits in the closure flags array anyways, use one for this information. - - - - - 08a6a2ee by Ben Gamari at 2022-04-22T02:12:59-04:00 rts: Mark closureFlags array as const - - - - - 8f9b8282 by Krzysztof Gogolewski at 2022-04-22T02:13:35-04:00 Check for zero-bit types in sizeExpr Fixes #20940 Metric Decrease: T18698a - - - - - fcf22883 by Andreas Klebinger at 2022-04-22T02:14:10-04:00 Include the way string in the file name for dump files. This can be disabled by `-fno-dump-with-ways` if not desired. Finally we will be able to look at both profiled and non-profiled dumps when compiling with dump flags and we compile in both ways. - - - - - 252394ce by Bodigrim at 2022-04-22T02:14:48-04:00 Improve error messages from GHC.IO.Encoding.Failure - - - - - 250f57c1 by Bodigrim at 2022-04-22T02:14:48-04:00 Update test baselines to match new error messages from GHC.IO.Encoding.Failure - - - - - 5ac9b321 by Ben Gamari at 2022-04-22T02:15:25-04:00 get-win32-tarballs: Drop i686 architecture As of #18487 we no longer support 32-bit Windows. Fixes #21372. - - - - - dd5fecb0 by Ben Gamari at 2022-04-22T02:16:00-04:00 hadrian: Don't rely on xxx not being present in installation path Previously Hadrian's installation makefile would assume that the string `xxx` did not appear in the installation path. This would of course break for some users. Fixes #21402. - - - - - 09e98859 by Ben Gamari at 2022-04-22T02:16:35-04:00 testsuite: Ensure that GHC doesn't pick up environment files Here we set GHC_ENVIRONMENT="-" to ensure that GHC invocations of tests don't pick up a user's local package environment. Fixes #21365. Metric Decrease: T10421 T12234 T12425 T13035 T16875 T9198 - - - - - 76bb8cb3 by Ben Gamari at 2022-04-22T02:17:11-04:00 hadrian: Enable -dlint in devel2 flavour Previously only -dcore-lint was enabled. - - - - - f435d55f by Krzysztof Gogolewski at 2022-04-22T08:00:18-04:00 Fixes to rubbish literals * In CoreToStg, the application 'RUBBISH[rep] x' was simplified to 'RUBBISH[rep]'. But it is possible that the result of the function is represented differently than the function. * In Unarise, 'LitRubbish (primRepToType prep)' is incorrect: LitRubbish takes a RuntimeRep such as IntRep, while primRepToType returns a type such as Any @(TYPE IntRep). Use primRepToRuntimeRep instead. This code is never run in the testsuite. * In StgToByteCode, all rubbish literals were assumed to be boxed. This code predates representation-polymorphic RubbishLit and I think it was not updated. I don't have a testcase for any of those issues, but the code looks wrong. - - - - - 93c16b94 by sheaf at 2022-04-22T08:00:57-04:00 Relax "suppressing errors" assert in reportWanteds The assertion in reportWanteds that we aren't suppressing all the Wanted constraints was too strong: it might be the case that we are inside an implication, and have already reported an unsolved Wanted from outside the implication. It is possible that all Wanteds inside the implication have been rewritten by the outer Wanted, so we shouldn't throw an assertion failure in that case. Fixes #21405 - - - - - 78ec692d by Andreas Klebinger at 2022-04-22T08:01:33-04:00 Mention new MutableByteArray# wrapper in base changelog. - - - - - 56d7cb53 by Eric Lindblad at 2022-04-22T14:13:32-04:00 unlist announce - - - - - 1e4dcf23 by sheaf at 2022-04-22T14:14:12-04:00 decideMonoTyVars: account for CoVars in candidates The "candidates" passed to decideMonoTyVars can contain coercion holes. This is because we might well decide to quantify over some unsolved equality constraints, as long as they are not definitely insoluble. In that situation, decideMonoTyVars was passing a set of type variables that was not closed over kinds to closeWrtFunDeps, which was tripping up an assertion failure. Fixes #21404 - - - - - 2c541f99 by Simon Peyton Jones at 2022-04-22T14:14:47-04:00 Improve floated dicts in Specialise Second fix to #21391. It turned out that we missed calling bringFloatedDictsIntoScope when specialising imports, which led to the same bug as before. I refactored to move that call to a single place, in specCalls, so we can't forget it. This meant making `FloatedDictBinds` into its own type, pairing the dictionary bindings themselves with the set of their binders. Nicer this way. - - - - - 0950e2c4 by Ben Gamari at 2022-04-25T10:18:17-04:00 hadrian: Ensure that --extra-lib-dirs are used Previously we only took `extraLibDirs` and friends from the package description, ignoring any contribution from the `LocalBuildInfo`. Fix this. Fixes #20566. - - - - - 53cc93ae by Ben Gamari at 2022-04-25T10:18:17-04:00 hadrian: Drop redundant include directories The package-specific include directories in Settings.Builders.Common.cIncludeDirs are now redundant since they now come from Cabal. Closes #20566. - - - - - b2721819 by Ben Gamari at 2022-04-25T10:18:17-04:00 hadrian: Clean up handling of libffi dependencies - - - - - 18e5103f by Ben Gamari at 2022-04-25T10:18:17-04:00 testsuite: More robust library way detection Previously `test.mk` would try to determine whether the dynamic, profiling, and vanilla library ways are available by searching for `PrimOpWrappers.{,dyn_,p_}hi` in directory reported by `ghc-pkg field ghc-prim library-dirs`. However, this is extremely fragile as there is no guarantee that there is only one library directory. To handle the case of multiple `library-dirs` correct we would have to carry out the delicate task of tokenising the directory list (in shell, no less). Since this isn't a task that I am eager to solve, I have rather moved the detection logic into the testsuite driver and instead perform a test compilation in each of the ways. This should be more robust than the previous approach. I stumbled upon this while fixing #20579. - - - - - 6c7a4913 by Ben Gamari at 2022-04-25T10:18:17-04:00 testsuite: Cabalify ghc-config To ensure that the build benefits from Hadrian's usual logic for building packages, avoiding #21409. Closes #21409. - - - - - 9af091f7 by Ben Gamari at 2022-04-25T10:18:53-04:00 rts: Factor out built-in GC roots - - - - - e7c4719d by Ben Gamari at 2022-04-25T10:18:54-04:00 Ensure that wired-in exception closures aren't GC'd As described in Note [Wired-in exceptions are not CAFfy], a small set of built-in exception closures get special treatment in the code generator, being declared as non-CAFfy despite potentially containing CAF references. The original intent of this treatment for the RTS to then add StablePtrs for each of the closures, ensuring that they are not GC'd. However, this logic was not applied consistently and eventually removed entirely in 951c1fb0. This lead to #21141. Here we fix this bug by reintroducing the StablePtrs and document the status quo. Closes #21141. - - - - - 9587726f by Ben Gamari at 2022-04-25T10:18:54-04:00 testsuite: Add testcase for #21141 - - - - - cb71226f by Ben Gamari at 2022-04-25T10:19:29-04:00 Drop dead code in GHC.Linker.Static.linkBinary' Previously we supported building statically-linked executables using libtool. However, this was dropped in 91262e75dd1d80f8f28a3922934ec7e59290e28c in favor of using ar/ranlib directly. Consequently we can drop this logic. Fixes #18826. - - - - - 9420d26b by Ben Gamari at 2022-04-25T10:19:29-04:00 Drop libtool path from settings file GHC no longers uses libtool for linking and therefore this is no longer necessary. - - - - - 41cf758b by Ben Gamari at 2022-04-25T10:19:29-04:00 Drop remaining vestiges of libtool Drop libtool logic from gen-dll, allowing us to drop the remaining logic from the `configure` script. Strangely, this appears to reliably reduce compiler allocations of T16875 on Windows. Closes #18826. Metric Decrease: T16875 - - - - - e09afbf2 by Ben Gamari at 2022-04-25T10:20:05-04:00 rts: Refactor handling of dead threads' stacks This fixes a bug that @JunmingZhao42 and I noticed while working on her MMTK port. Specifically, in stg_stop_thread we used stg_enter_info as a sentinel at the tail of a stack after a thread has completed. However, stg_enter_info expects to have a two-field payload, which we do not push. Consequently, if the GC ends up somehow the stack it will attempt to interpret data past the end of the stack as the frame's fields, resulting in unsound behavior. To fix this I eliminate this hacky use of `stg_stop_thread` and instead introduce a new stack frame type, `stg_dead_thread_info`. Not only does this eliminate the potential for the previously mentioned memory unsoundness but it also more clearly captures the intended structure of the dead threads' stacks. - - - - - e76705cf by Ben Gamari at 2022-04-25T10:20:05-04:00 rts: Improve documentation of closure types Also drops the unused TREC_COMMITTED transaction state. - - - - - f2c08124 by Bodigrim at 2022-04-25T10:20:44-04:00 Document behaviour of RULES with KnownNat - - - - - 360dc2bc by Li-yao Xia at 2022-04-25T19:13:06+00:00 Fix rendering of liftA haddock - - - - - 16df6058 by Ben Gamari at 2022-04-27T10:02:25-04:00 testsuite: Report minimum and maximum stat changes As suggested in #20733. - - - - - e39cab62 by Fabian Thorand at 2022-04-27T10:03:03-04:00 Defer freeing of mega block groups Solves the quadratic worst case performance of freeing megablocks that was described in issue #19897. During GC runs, we now keep a secondary free list for megablocks that is neither sorted, nor coalesced. That way, free becomes an O(1) operation at the expense of not being able to reuse memory for larger allocations. At the end of a GC run, the secondary free list is sorted and then merged into the actual free list in a single pass. That way, our worst case performance is O(n log(n)) rather than O(n^2). We postulate that temporarily losing coalescense during a single GC run won't have any adverse effects in practice because: - We would need to release enough memory during the GC, and then after that (but within the same GC run) allocate a megablock group of more than one megablock. This seems unlikely, as large objects are not copied during GC, and so we shouldn't need such large allocations during a GC run. - Allocations of megablock groups of more than one megablock are rare. They only happen when a single heap object is large enough to require that amount of space. Any allocation areas that are supposed to hold more than one heap object cannot use megablock groups, because only the first megablock of a megablock group has valid `bdescr`s. Thus, heap object can only start in the first megablock of a group, not in later ones. - - - - - 5de6be0c by Fabian Thorand at 2022-04-27T10:03:03-04:00 Add note about inefficiency in returnMemoryToOS - - - - - 8bef471a by sheaf at 2022-04-27T10:03:43-04:00 Ensure that Any is Boxed in FFI imports/exports We should only accept the type `Any` in foreign import/export declarations when it has type `Type` or `UnliftedType`. This patch adds a kind check, and a special error message triggered by occurrences of `Any` in foreign import/export declarations at other kinds. Fixes #21305 - - - - - ba3d4e1c by Ben Gamari at 2022-04-27T10:04:19-04:00 Basic response file support Here we introduce support into our command-line parsing infrastructure and driver for handling gnu-style response file arguments, typically used to work around platform command-line length limitations. Fixes #16476. - - - - - 3b6061be by Ben Gamari at 2022-04-27T10:04:19-04:00 testsuite: Add test for #16476 - - - - - 75bf1337 by Matthew Pickering at 2022-04-27T10:04:55-04:00 ci: Fix cabal-reinstall job It's quite nice we can do this by mostly deleting code Fixes #21373 - - - - - 2c00d904 by Matthew Pickering at 2022-04-27T10:04:55-04:00 ci: Add test to check that release jobs have profiled libs - - - - - 50d78d3b by Matthew Pickering at 2022-04-27T10:04:55-04:00 ci: Explicitly handle failures in test_hadrian We also disable the stage1 testing which is broken. Related to #21072 - - - - - 2dcdf091 by Matthew Pickering at 2022-04-27T10:04:55-04:00 ci: Fix shell command - - - - - 55c84123 by Matthew Pickering at 2022-04-27T10:04:55-04:00 bootstrap: Add bootstrapping files for ghc-9_2_2 Fixes #21373 - - - - - c7ee0be6 by Matthew Pickering at 2022-04-27T10:04:55-04:00 ci: Add linting job which checks authors are not GHC CI - - - - - 23aad124 by Adam Sandberg Ericsson at 2022-04-27T10:05:31-04:00 rts: state explicitly what evacuate and scavange mean in the copying gc - - - - - 318e0005 by Ben Gamari at 2022-04-27T10:06:07-04:00 rts/eventlog: Don't attempt to flush if there is no writer If the user has not configured a writer then there is nothing to flush. - - - - - ee11d043 by Ben Gamari at 2022-04-27T10:06:07-04:00 Enable eventlog support in all ways by default Here we deprecate the eventlogging RTS ways and instead enable eventlog support in the remaining ways. This simplifies packaging and reduces GHC compilation times (as we can eliminate two whole compilations of the RTS) while simplifying the end-user story. The trade-off is a small increase in binary sizes in the case that the user does not want eventlogging support, but we think that this is a fine trade-off. This also revealed a latent RTS bug: some files which included `Cmm.h` also assumed that it defined various macros which were in fact defined by `Config.h`, which `Cmm.h` did not include. Fixing this in turn revealed that `StgMiscClosures.cmm` failed to import various spinlock statistics counters, as evidenced by the failed unregisterised build. Closes #18948. - - - - - a2e5ab70 by Andreas Klebinger at 2022-04-27T10:06:43-04:00 Change `-dsuppress-ticks` to only suppress non-code ticks. This means cost centres and coverage ticks will still be present in output. Makes using -dsuppress-all more convenient when looking at profiled builds. - - - - - ec9d7e04 by Ben Gamari at 2022-04-27T10:07:21-04:00 Bump text submodule. This should fix #21352 - - - - - c3105be4 by Bodigrim at 2022-04-27T10:08:01-04:00 Documentation for setLocaleEncoding - - - - - 7f618fd3 by sheaf at 2022-04-27T10:08:40-04:00 Update docs for change to type-checking plugins There was no mention of the changes to type-checking plugins in the 9.4.1 notes, and the extending_ghc documentation contained a reference to an outdated type. - - - - - 4419dd3a by Adam Sandberg Ericsson at 2022-04-27T10:09:18-04:00 rts: add some more documentation to StgWeak closure type - - - - - 5a7f0dee by Matthew Pickering at 2022-04-27T10:09:54-04:00 Give Cmm files fake ModuleNames which include full filepath This fixes the initialisation functions when using -prof or -finfo-table-map. Fixes #21370 - - - - - 81cf52bb by sheaf at 2022-04-27T10:10:33-04:00 Mark GHC.Prim.PtrEq as Unsafe This module exports unsafe pointer equality operations, so we accordingly mark it as Unsafe. Fixes #21433 - - - - - f6a8185d by Ben Gamari at 2022-04-28T09:10:31+00:00 testsuite: Add performance test for #14766 This distills the essence of the Sigs.hs program found in the ticket. - - - - - c7a3dc29 by Douglas Wilson at 2022-04-28T18:54:44-04:00 hadrian: Add Monoid instance to Way - - - - - 654bafea by Douglas Wilson at 2022-04-28T18:54:44-04:00 hadrian: Enrich flavours to build profiled/debugged/threaded ghcs per stage - - - - - 4ad559c8 by Douglas Wilson at 2022-04-28T18:54:44-04:00 hadrian: add debug_ghc and debug_stage1_ghc flavour transformers - - - - - f9728fdb by Douglas Wilson at 2022-04-28T18:54:44-04:00 hadrian: Don't pass -rtsopts when building libraries - - - - - 769279e6 by Matthew Pickering at 2022-04-28T18:54:44-04:00 testsuite: Fix calculation about whether to pass -dynamic to compiler - - - - - da8ae7f2 by Ben Gamari at 2022-04-28T18:55:20-04:00 hadrian: Clean up flavour transformer definitions Previously the `ipe` and `omit_pragmas` transformers were hackily defined using the textual key-value syntax. Fix this. - - - - - 61305184 by Ben Gamari at 2022-04-28T18:55:56-04:00 Bump process submodule - - - - - a8c99391 by sheaf at 2022-04-28T18:56:37-04:00 Fix unification of ConcreteTvs, removing IsRefl# This patch fixes the unification of concrete type variables. The subtlety was that unifying concrete metavariables is more subtle than other metavariables, as decomposition is possible. See the Note [Unifying concrete metavariables], which explains how we unify a concrete type variable with a type 'ty' by concretising 'ty', using the function 'GHC.Tc.Utils.Concrete.concretise'. This can be used to perform an eager syntactic check for concreteness, allowing us to remove the IsRefl# special predicate. Instead of emitting two constraints `rr ~# concrete_tv` and `IsRefl# rr concrete_tv`, we instead concretise 'rr'. If this succeeds we can fill 'concrete_tv', and otherwise we directly emit an error message to the typechecker environment instead of deferring. We still need the error message to be passed on (instead of directly thrown), as we might benefit from further unification in which case we will need to zonk the stored types. To achieve this, we change the 'wc_holes' field of 'WantedConstraints' to 'wc_errors', which stores general delayed errors. For the moement, a delayed error is either a hole, or a syntactic equality error. hasFixedRuntimeRep_MustBeRefl is now hasFixedRuntimeRep_syntactic, and hasFixedRuntimeRep has been refactored to directly return the most useful coercion for PHASE 2 of FixedRuntimeRep. This patch also adds a field ir_frr to the InferResult datatype, holding a value of type Maybe FRROrigin. When this value is not Nothing, this means that we must fill the ir_ref field with a type which has a fixed RuntimeRep. When it comes time to fill such an ExpType, we ensure that the type has a fixed RuntimeRep by performing a representation-polymorphism check with the given FRROrigin This is similar to what we already do to ensure we fill an Infer ExpType with a type of the correct TcLevel. This allows us to properly perform representation-polymorphism checks on 'Infer' 'ExpTypes'. The fillInferResult function had to be moved to GHC.Tc.Utils.Unify to avoid a cyclic import now that it calls hasFixedRuntimeRep. This patch also changes the code in matchExpectedFunTys to make use of the coercions, which is now possible thanks to the previous change. This implements PHASE 2 of FixedRuntimeRep in some situations. For example, the test cases T13105 and T17536b are now both accepted. Fixes #21239 and #21325 ------------------------- Metric Decrease: T18223 T5631 ------------------------- - - - - - 43bd897d by Simon Peyton Jones at 2022-04-28T18:57:13-04:00 Add INLINE pragmas for Enum helper methods As #21343 showed, we need to be super-certain that the "helper methods" for Enum instances are actually inlined or specialised. I also tripped over this when I discovered that numericEnumFromTo and friends had no pragmas at all, so their performance was very fragile. If they weren't inlined, all bets were off. So I've added INLINE pragmas for them too. See new Note [Inline Enum method helpers] in GHC.Enum. I also expanded Note [Checking for INLINE loop breakers] in GHC.Core.Lint to explain why an INLINE function might temporarily be a loop breaker -- this was the initial bug report in #21343. Strangely we get a 16% runtime allocation decrease in perf/should_run/T15185, but only on i386. Since it moves in the right direction I'm disinclined to investigate, so I'll accept it. Metric Decrease: T15185 - - - - - ca1434e3 by Ben Gamari at 2022-04-28T18:57:49-04:00 configure: Bump GHC version to 9.5 Bumps haddock submodule. - - - - - 292e3971 by Teo Camarasu at 2022-04-28T18:58:28-04:00 add since annotation for GHC.Stack.CCS.whereFrom - - - - - 905206d6 by Tamar Christina at 2022-04-28T22:19:34-04:00 winio: add support to iserv. - - - - - d182897e by Tamar Christina at 2022-04-28T22:19:34-04:00 Remove unused line - - - - - 22cf4698 by Matthew Pickering at 2022-04-28T22:20:10-04:00 Revert "rts: Refactor handling of dead threads' stacks" This reverts commit e09afbf2a998beea7783e3de5dce5dd3c6ff23db. - - - - - 8ed57135 by Matthew Pickering at 2022-04-29T04:11:29-04:00 Provide efficient unionMG function for combining two module graphs. This function is used by API clients (hls). This supercedes !6922 - - - - - 0235ff02 by Ben Gamari at 2022-04-29T04:12:05-04:00 Bump bytestring submodule Update to current `master`. - - - - - 01988418 by Matthew Pickering at 2022-04-29T04:12:05-04:00 testsuite: Normalise package versions in UnusedPackages test - - - - - 724d0dc0 by Matthew Pickering at 2022-04-29T08:59:42+00:00 testsuite: Deduplicate ways correctly This was leading to a bug where we would run a profasm test twice which led to invalid junit.xml which meant the test results database was not being populated for the fedora33-perf job. - - - - - 5630dde6 by Ben Gamari at 2022-04-29T13:06:20-04:00 rts: Refactor handling of dead threads' stacks This fixes a bug that @JunmingZhao42 and I noticed while working on her MMTK port. Specifically, in stg_stop_thread we used stg_enter_info as a sentinel at the tail of a stack after a thread has completed. However, stg_enter_info expects to have a two-field payload, which we do not push. Consequently, if the GC ends up somehow the stack it will attempt to interpret data past the end of the stack as the frame's fields, resulting in unsound behavior. To fix this I eliminate this hacky use of `stg_stop_thread` and instead introduce a new stack frame type, `stg_dead_thread_info`. Not only does this eliminate the potential for the previously mentioned memory unsoundness but it also more clearly captures the intended structure of the dead threads' stacks. - - - - - 0cdef807 by parsonsmatt at 2022-04-30T16:51:12-04:00 Add a note about instance visibility across component boundaries In principle, the *visible* instances are * all instances defined in a prior top-level declaration group (see docs on `newDeclarationGroup`), or * all instances defined in any module transitively imported by the module being compiled However, actually searching all modules transitively below the one being compiled is unreasonably expensive, so `reifyInstances` will report only the instance for modules that GHC has had some cause to visit during this compilation. This is a shortcoming: `reifyInstances` might fail to report instances for a type that is otherwise unusued, or instances defined in a different component. You can work around this shortcoming by explicitly importing the modules whose instances you want to be visible. GHC issue #20529 has some discussion around this. Fixes #20529 - - - - - e2dd884a by Ryan Scott at 2022-04-30T16:51:47-04:00 Make mkFunCo take AnonArgFlags into account Previously, whenever `mkFunCo` would produce reflexive coercions, it would use `mkVisFunTy` to produce the kind of the coercion. However, `mkFunCo` is also used to produce coercions between types of the form `ty1 => ty2` in certain places. This has the unfortunate side effect of causing the type of the coercion to appear as `ty1 -> ty2` in certain error messages, as spotted in #21328. This patch address this by changing replacing the use of `mkVisFunTy` with `mkFunctionType` in `mkFunCo`. `mkFunctionType` checks the kind of `ty1` and makes the function arrow `=>` instead of `->` if `ty1` has kind `Constraint`, so this should always produce the correct `AnonArgFlag`. As a result, this patch fixes part (2) of #21328. This is not the only possible way to fix #21328, as the discussion on that issue lists some possible alternatives. Ultimately, it was concluded that the alternatives would be difficult to maintain, and since we already use `mkFunctionType` in `coercionLKind` and `coercionRKind`, using `mkFunctionType` in `mkFunCo` is consistent with this choice. Moreover, using `mkFunctionType` does not regress the performance of any test case we have in GHC's test suite. - - - - - 170da54f by Ben Gamari at 2022-04-30T16:52:27-04:00 Convert More Diagnostics (#20116) Replaces uses of `TcRnUnknownMessage` with proper diagnostics constructors. - - - - - 39edc7b4 by Marius Ghita at 2022-04-30T16:53:06-04:00 Update user guide example rewrite rules formatting Change the rewrite rule examples to include a space between the composition of `f` and `g` in the map rewrite rule examples. Without this change, if the user has locally enabled the extension OverloadedRecordDot the copied example will result in a compile time error that `g` is not a field of `f`. ``` • Could not deduce (GHC.Records.HasField "g" (a -> b) (a1 -> b)) arising from selecting the field ‘g’ ``` - - - - - 2e951e48 by Adam Sandberg Ericsson at 2022-04-30T16:53:42-04:00 ghc-boot: export typesynonyms from GHC.Utils.Encoding This makes the Haddocks easier to understand. - - - - - d8cbc77e by Adam Sandberg Ericsson at 2022-04-30T16:54:18-04:00 users guide: add categories to some flags - - - - - d0f14fad by Chris Martin at 2022-04-30T16:54:57-04:00 hacking guide: mention the core libraries committee - - - - - 34b28200 by Matthew Pickering at 2022-04-30T16:55:32-04:00 Revert "Make the specialiser handle polymorphic specialisation" This reverts commit ef0135934fe32da5b5bb730dbce74262e23e72e8. See ticket #21229 ------------------------- Metric Decrease: T15164 Metric Increase: T13056 ------------------------- - - - - - ee891c1e by Matthew Pickering at 2022-04-30T16:55:32-04:00 Add test for T21229 - - - - - ab677cc8 by Matthew Pickering at 2022-04-30T16:56:08-04:00 Hadrian: Update README about the flavour/testsuite contract There have been a number of tickets about non-tested flavours not passing the testsuite.. this is expected and now noted in the documentation. You use other flavours to run the testsuite at your own risk. Fixes #21418 - - - - - b57b5b92 by Ben Gamari at 2022-04-30T16:56:44-04:00 rts/m32: Fix assertion failure This fixes an assertion failure in the m32 allocator due to the imprecisely specified preconditions of `m32_allocator_push_filled_list`. Specifically, the caller must ensure that the page type is set to filled prior to calling `m32_allocator_push_filled_list`. While this issue did result in an assertion failure in the debug RTS, the issue is in fact benign. - - - - - a7053a6c by sheaf at 2022-04-30T16:57:23-04:00 Testsuite driver: don't crash on empty metrics The testsuite driver crashed when trying to display minimum/maximum performance changes when there are no metrics (i.e. there is no baseline available). This patch fixes that. - - - - - 636f7c62 by Andreas Klebinger at 2022-05-01T22:21:17-04:00 StgLint: Check that functions are applied to compatible runtime reps We use compatibleRep to compare reps, and avoid checking functions with levity polymorphic types because of #21399. - - - - - 60071076 by Hécate Moonlight at 2022-05-01T22:21:55-04:00 Add documentation to the ByteArray# primetype. close #21417 - - - - - 2b2e3020 by Andreas Klebinger at 2022-05-01T22:22:31-04:00 exprIsDeadEnd: Use isDeadEndAppSig to check if a function appliction is bottoming. We used to check the divergence and that the number of arguments > arity. But arity zero represents unknown arity so this was subtly broken for a long time! We would check if the saturated function diverges, and if we applied >=arity arguments. But for unknown arity functions any number of arguments is >=idArity. This fixes #21440. - - - - - 4eaf0f33 by Eric Lindblad at 2022-05-01T22:23:11-04:00 typos - - - - - fc58df90 by Niklas Hambüchen at 2022-05-02T08:59:27+00:00 libraries/base: docs: Explain relationshipt between `finalizeForeignPtr` and `*Conc*` creation Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/21420 - - - - - 3e400f20 by Krzysztof Gogolewski at 2022-05-02T18:29:23-04:00 Remove obsolete code in CoreToStg Note [Nullary unboxed tuple] was removed in e9e61f18a548b70693f4. This codepath is tested by T15696_3. - - - - - 4a780928 by Krzysztof Gogolewski at 2022-05-02T18:29:24-04:00 Fix several note references - - - - - 15ffe2b0 by Sebastian Graf at 2022-05-03T20:11:51+02:00 Assume at least one evaluation for nested SubDemands (#21081, #21133) See the new `Note [SubDemand denotes at least one evaluation]`. A demand `n :* sd` on a let binder `x=e` now means > "`x` was evaluated `n` times and in any program trace it is evaluated, `e` is > evaluated deeply in sub-demand `sd`." The "any time it is evaluated" premise is what this patch adds. As a result, we get better nested strictness. For example (T21081) ```hs f :: (Bool, Bool) -> (Bool, Bool) f pr = (case pr of (a,b) -> a /= b, True) -- before: <MP(L,L)> -- after: <MP(SL,SL)> g :: Int -> (Bool, Bool) g x = let y = let z = odd x in (z,z) in f y ``` The change in demand signature "before" to "after" allows us to case-bind `z` here. Similarly good things happen for the `sd` in call sub-demands `Cn(sd)`, which allows for more eta-reduction (which is only sound with `-fno-pedantic-bottoms`, albeit). We also fix #21085, a surprising inconsistency with `Poly` to `Call` sub-demand expansion. In an attempt to fix a regression caused by less inlining due to eta-reduction in T15426, I eta-expanded the definition of `elemIndex` and `elemIndices`, thus fixing #21345 on the go. The main point of this patch is that it fixes #21081 and #21133. Annoyingly, I discovered that more precise demand signatures for join points can transform a program into a lazier program if that join point gets floated to the top-level, see #21392. There is no simple fix at the moment, but !5349 might. Thus, we accept a ~5% regression in `MultiLayerModulesTH_OneShot`, where #21392 bites us in `addListToUniqDSet`. T21392 reliably reproduces the issue. Surprisingly, ghc/alloc perf on Windows improves much more than on other jobs, by 0.4% in the geometric mean and by 2% in T16875. Metric Increase: MultiLayerModulesTH_OneShot Metric Decrease: T16875 - - - - - 948c7e40 by Andreas Klebinger at 2022-05-04T09:57:34-04:00 CoreLint - When checking for levity polymorphism look through more ticks. For expressions like `(scc<cc_name> primOp#) arg1` we should also look at arg1 to determine if we call primOp# at a fixed runtime rep. This is what corePrep already does but CoreLint didn't yet. This patch will bring them in sync in this regard. It also uses tickishFloatable in CorePrep instead of CorePrep having it's own slightly differing definition of when a tick is floatable. - - - - - 85bc73bd by Alexis King at 2022-05-04T09:58:14-04:00 genprimopcode: Support Unicode properly - - - - - 063d485e by Alexis King at 2022-05-04T09:58:14-04:00 genprimopcode: Replace LaTeX documentation syntax with Haddock The LaTeX documentation generator does not seem to have been used for quite some time, so the LaTeX-to-Haddock preprocessing step has become a pointless complication that makes documenting the contents of GHC.Prim needlessly difficult. This commit replaces the LaTeX syntax with the Haddock it would have been converted into, anyway, though with an additional distinction: it uses single quotes in places to instruct Haddock to generate hyperlinks to bindings. This improves the quality of the generated output. - - - - - d61f7428 by Ben Gamari at 2022-05-04T09:58:50-04:00 rts/ghc.mk: Only build StgCRunAsm.S when it is needed Previously the make build system unconditionally included StgCRunAsm.S in the link, meaning that the RTS would require an execstack unnecessarily. Fixes #21478. - - - - - 934a90dd by Simon Peyton Jones at 2022-05-04T16:15:34-04:00 Improve error reporting in generated code Our error reporting in generated code (via desugaring before typechecking) only worked when the generated code was just a simple call. This commit makes it work in nested cases. - - - - - 445d3657 by sheaf at 2022-05-04T16:16:12-04:00 Ensure Any is not levity-polymorphic in FFI The previous patch forgot to account for a type such as Any @(TYPE (BoxedRep l)) for a quantified levity variable l. - - - - - ddd2591c by Ben Gamari at 2022-05-04T16:16:48-04:00 Update supported LLVM versions Pull forward minimum version to match 9.2. (cherry picked from commit c26faa54c5fbe902ccb74e79d87e3fa705e270d1) - - - - - f9698d79 by Ben Gamari at 2022-05-04T16:16:48-04:00 testsuite/T7275: Use sed -r Darwin requires the `-r` flag to be compatible with GNU sed. (cherry picked from commit 512338c8feec96c38ef0cf799f3a01b77c967c56) - - - - - 8635323b by Ben Gamari at 2022-05-04T16:16:48-04:00 gitlab-ci: Use ld.lld on ARMv7/Linux Due to #16177. Also cleanup some code style issues. (cherry picked from commit cc1c3861e2372f464bf9e3c9c4d4bd83f275a1a6) - - - - - 4f6370c7 by Ben Gamari at 2022-05-04T16:16:48-04:00 gitlab-ci: Always preserve artifacts, even in failed jobs (cherry picked from commit fd08b0c91ea3cab39184f1b1b1aafcd63ce6973f) - - - - - 6f662754 by Ben Gamari at 2022-05-04T16:16:48-04:00 configure: Make sphinx version check more robust It appears that the version of sphinx shipped on CentOS 7 reports a version string of `Sphinx v1...`. Accept the `v`. (cherry picked from commit a9197a292fd4b13308dc6664c01351c7239357ed) - - - - - 0032dc38 by Ben Gamari at 2022-05-04T16:16:48-04:00 gitlab-ci: Don't run make job in release pipelines (cherry picked from commit 16d6a8ff011f2194485387dcca1c00f8ddcdbdeb) - - - - - 27f9aab3 by Ben Gamari at 2022-05-04T16:16:48-04:00 gitlab/ci: Fix name of bootstrap compiler directory Windows binary distributions built with Hadrian have a target platform suffix in the name of their root directory. Teach `ci.sh` about this fact. (cherry picked from commit df5752f39671f6d04d8cd743003469ae5eb67235) - - - - - b528f0f6 by Krzysztof Gogolewski at 2022-05-05T09:05:43-04:00 Fix several note references, part 2 - - - - - 691aacf6 by Adam Sandberg Ericsson at 2022-05-05T09:06:19-04:00 adjustors: align comment about number of integer like arguments with implementation for Amd4+MinGW implementation - - - - - f050557e by Simon Jakobi at 2022-05-05T12:47:32-04:00 Remove two uses of IntMap.size IntMap.size is O(n). The new code should be slightly more efficient. The transformation of GHC.CmmToAsm.CFG.calcFreqs.nodeCount can be described formally as the transformation: (\sum_{0}^{n-1} \sum_{0}^{k-1} i_nk) + n ==> (\sum_{0}^{n-1} 1 + \sum_{0}^{k-1} i_nk) - - - - - 7da90ae3 by Tom Ellis at 2022-05-05T12:48:09-04:00 Explain that 'fail s' should run in the monad itself - - - - - 610d0283 by Matthew Craven at 2022-05-05T12:48:47-04:00 Add a test for the bracketing in rules for (^) - - - - - 016f9ca6 by Matthew Craven at 2022-05-05T12:48:47-04:00 Fix broken rules for (^) with known small powers - - - - - 9372aaab by Matthew Craven at 2022-05-05T12:48:47-04:00 Give the two T19569 tests different names - - - - - 61901b32 by Andreas Klebinger at 2022-05-05T12:49:23-04:00 SpecConstr: Properly create rules for call patterns representing partial applications The main fix is that in addVoidWorkerArg we now add the argument to the front. This fixes #21448. ------------------------- Metric Decrease: T16875 ------------------------- - - - - - 71278dc7 by Teo Camarasu at 2022-05-05T12:50:03-04:00 add since annotations for instances of ByteArray - - - - - 962ff90b by sheaf at 2022-05-05T12:50:42-04:00 Start 9.6.1-notes Updates the documentation notes to start tracking changes for the 9.6.1 release (instead of 9.4). - - - - - aacb15a3 by Matthew Pickering at 2022-05-05T20:24:01-04:00 ci: Add job to check that jobs.yaml is up-to-date There have been quite a few situations where jobs.yaml has been out of date. It's better to add a CI job which checks that it's right. We don't want to use a staged pipeline because it obfuscates the structure of the pipeline. - - - - - be7102e5 by Ben Gamari at 2022-05-05T20:24:37-04:00 rts: Ensure that XMM registers are preserved on Win64 Previously we only preserved the bottom 64-bits of the callee-saved 128-bit XMM registers, in violation of the Win64 calling convention. Fix this. Fixes #21465. - - - - - 73b22ff1 by Ben Gamari at 2022-05-05T20:24:37-04:00 testsuite: Add test for #21465 - - - - - e2ae9518 by Ziyang Liu at 2022-05-06T19:22:22-04:00 Allow `let` just before pure/return in ApplicativeDo The following is currently rejected: ```haskell -- F is an Applicative but not a Monad x :: F (Int, Int) x = do a <- pure 0 let b = 1 pure (a, b) ``` This has bitten me multiple times. This MR contains a simple fix: only allow a "let only" segment to be merged with the next (and not the previous) segment. As a result, when the last one or more statements before pure/return are `LetStmt`s, there will be one more segment containing only those `LetStmt`s. Note that if the `let` statement mentions a name bound previously, then the program is still rejected, for example ```haskell x = do a <- pure 0 let b = a + 1 pure (a, b) ``` or the example in #18559. To support this would require a more complex approach, but this is IME much less common than the previous case. - - - - - 0415449a by Matthew Pickering at 2022-05-06T19:22:58-04:00 template-haskell: Fix representation of OPAQUE pragmas There is a mis-match between the TH representation of OPAQUE pragmas and GHC's internal representation due to how OPAQUE pragmas disallow phase annotations. It seemed most in keeping to just fix the wired in name issue by adding a special case to the desugaring of INLINE pragmas rather than making TH/GHC agree with how the representation should look. Fixes #21463 - - - - - 4de887e2 by Simon Peyton Jones at 2022-05-06T19:23:34-04:00 Comments only: Note [AppCtxt] - - - - - 6e69964d by Matthew Pickering at 2022-05-06T19:24:10-04:00 Fix name of windows release bindist in doc-tarball job - - - - - ced4689e by Matthew Pickering at 2022-05-06T19:24:46-04:00 ci: Generate source-tarball in release jobs We need to distribute the source tarball so we should generate it in the CI pipeline. - - - - - 3c91de21 by Rob at 2022-05-08T13:40:53+02:00 Change Specialise to use OrdList. Fixes #21362 Metric Decrease: T16875 - - - - - 67072c31 by Simon Jakobi at 2022-05-08T12:23:43-04:00 Tweak GHC.CmmToAsm.CFG.delEdge mapAdjust is more efficient than mapAlter. - - - - - 374554bb by Teo Camarasu at 2022-05-09T16:24:37-04:00 Respect -po when heap profiling (#21446) - - - - - 1ea414b6 by Teo Camarasu at 2022-05-09T16:24:37-04:00 add test case for #21446 - - - - - c7902078 by Jens Petersen at 2022-05-09T16:25:17-04:00 avoid hadrian/bindist/Makefile install_docs error when --docs=none When docs are disabled the bindist does not have docs/ and hence docs-utils/ is not generated. Here we just test that docs-utils exists before attempting to install prologue.txt and gen_contents_index to avoid the error: /usr/bin/install: cannot stat 'docs-utils/prologue.txt': No such file or directory make: *** [Makefile:195: install_docs] Error 1 - - - - - 158bd659 by Hécate Moonlight at 2022-05-09T16:25:56-04:00 Correct base's changelog for 4.16.1.0 This commit reaffects the new Ix instances of the foreign integral types from base 4.17 to 4.16.1.0 closes #21529 - - - - - a4fbb589 by Sylvain Henry at 2022-05-09T16:26:36-04:00 STG: only print cost-center if asked to - - - - - 50347ded by Gergo ERDI at 2022-05-10T11:43:33+00:00 Improve "Glomming" note Add a paragraph that clarifies that `occurAnalysePgm` finding out-of-order references, and thus needing to glom, is not a cause for concern when its root cause is rewrite rules. - - - - - df2e3373 by Eric Lindblad at 2022-05-10T20:45:41-04:00 update INSTALL - - - - - dcac3833 by Matthew Pickering at 2022-05-10T20:46:16-04:00 driver: Make -no-keep-o-files -no-keep-hi-files work in --make mode It seems like it was just an oversight to use the incorrect DynFlags (global rather than local) when implementing these two options. Using the local flags allows users to request these intermediate files get cleaned up, which works fine in --make mode because 1. Interface files are stored in memory 2. Object files are only cleaned at the end of session (after link) Fixes #21349 - - - - - 35da81f8 by Ben Gamari at 2022-05-10T20:46:52-04:00 configure: Check for ffi.h As noted in #21485, we checked for ffi.h yet then failed to throw an error if it is missing. Fixes #21485. - - - - - bdc99cc2 by Simon Peyton Jones at 2022-05-10T20:47:28-04:00 Check for uninferrable variables in tcInferPatSynDecl This fixes #21479 See Note [Unquantified tyvars in a pattern synonym] While doing this, I found that some error messages pointed at the pattern synonym /name/, rather than the /declaration/ so I widened the SrcSpan to encompass the declaration. - - - - - 142a73d9 by Matthew Pickering at 2022-05-10T20:48:04-04:00 hadrian: Fix split-sections transformer The splitSections transformer has been broken since -dynamic-too support was implemented in hadrian. This is because we actually build the dynamic way when building the dynamic way, so the predicate would always fail. The fix is to just always pass `split-sections` even if it doesn't do anything for a particular way. Fixes #21138 - - - - - 699f5935 by Matthew Pickering at 2022-05-10T20:48:04-04:00 packaging: Build perf builds with -split-sections In 8f71d958 the make build system was made to use split-sections on linux systems but it appears this logic never made it to hadrian. There is the split_sections flavour transformer but this doesn't appear to be used for perf builds on linux. Closes #21135 - - - - - 21feece2 by Simon Peyton Jones at 2022-05-10T20:48:39-04:00 Use the wrapper for an unlifted binding We assumed the wrapper for an unlifted binding is the identity, but as #21516 showed, that is no always true. Solution is simple: use it. - - - - - 68d1ea5f by Matthew Pickering at 2022-05-10T20:49:15-04:00 docs: Fix path to GHC API docs in index.html In the make bindists we generate documentation in docs/ghc-<VER> but the hadrian bindists generate docs/ghc/ so the path to the GHC API docs was wrong in the index.html file. Rather than make the hadrian and make bindists the same it was easier to assume that if you're using the mkDocs script that you're using hadrian bindists. Fixes #21509 - - - - - 9d8f44a9 by Matthew Pickering at 2022-05-10T20:49:51-04:00 hadrian: Don't pass -j to haddock This has high potential for oversubcribing as many haddock jobs can be spawned in parralel which will each request the given number of capabilities. Once -jsem is implemented (#19416, !5176) we can expose that haddock via haddock and use that to pass a semaphore. Ticket #21136 - - - - - fec3e7aa by Matthew Pickering at 2022-05-10T20:50:27-04:00 hadrian: Only copy and install libffi headers when using in-tree libffi When passed `--use-system-libffi` then we shouldn't copy and install the headers from the system package. Instead the headers are expected to be available as a runtime dependency on the users system. Fixes #21485 #21487 - - - - - 5b791ed3 by mikael at 2022-05-11T08:22:13-04:00 FIND_LLVM_PROG: Recognize llvm suffix used by FreeBSD, ie llc10. - - - - - 8500206e by ARATA Mizuki at 2022-05-11T08:22:57-04:00 Make floating-point abs IEEE 754 compliant The old code used by via-C backend didn't handle the sign bit of NaN. See #21043. - - - - - 4a4c77ed by Alan Zimmerman at 2022-05-11T08:23:33-04:00 EPA: do statement with leading semicolon has wrong anchor The code do; a <- doAsync; b Generated an incorrect Anchor for the statement list that starts after the first semicolon. This commit fixes it. Closes #20256 - - - - - e3ca8dac by Simon Peyton Jones at 2022-05-11T08:24:08-04:00 Specialiser: saturate DFuns correctly Ticket #21489 showed that the saturation mechanism for DFuns (see Note Specialising DFuns) should use both UnspecType and UnspecArg. We weren't doing that; but this MR fixes that problem. No test case because it's hard to tickle, but it showed up in Gergo's work with GHC-as-a-library. - - - - - fcc7dc4c by Ben Gamari at 2022-05-11T20:05:41-04:00 gitlab-ci: Check for dynamic msys2 dependencies Both #20878 and #21196 were caused by unwanted dynamic dependencies being introduced by boot libraries. Ensure that we catch this in CI by attempting to run GHC in an environment with a minimal PATH. - - - - - 3c998f0d by Matthew Pickering at 2022-05-11T20:06:16-04:00 Add back Debian9 CI jobs 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. Fixes #21469 - - - - - dea9a3d9 by Ben Gamari at 2022-05-11T20:06:51-04:00 rts: Drop setExecutable Since f6e366c058b136f0789a42222b8189510a3693d1 setExecutable has been dead code. Drop it. - - - - - 32cdf62d by Simon Peyton Jones at 2022-05-11T20:07:27-04:00 Add a missing guard in GHC.HsToCore.Utils.is_flat_prod_pat This missing guard gave rise to #21519. - - - - - 2c00a8d0 by Matthew Pickering at 2022-05-11T20:08:02-04:00 Add mention of -hi to RTS --help Fixes #21546 - - - - - a2dcad4e by Andre Marianiello at 2022-05-12T02:15:48+00:00 Decouple dynflags in Cmm parser (related to #17957) - - - - - 3a022baa by Andre Marianiello at 2022-05-12T02:15:48+00:00 Remove Module argument from initCmmParserConfig - - - - - 2fc8d76b by Andre Marianiello at 2022-05-12T02:15:48+00:00 Move CmmParserConfig and PDConfig into GHC.Cmm.Parser.Config - - - - - b8c5ffab by Andre Marianiello at 2022-05-12T18:13:55-04:00 Decouple dynflags in GHC.Core.Opt.Arity (related to #17957) Metric Decrease: T16875 - - - - - 3bf938b6 by sheaf at 2022-05-12T18:14:34-04:00 Update extending_ghc for TcPlugin changes The documentation still mentioned Derived constraints and an outdated datatype TcPluginResult. - - - - - 668a9ef4 by jackohughes at 2022-05-13T12:10:34-04:00 Fix printing of brackets in multiplicities (#20315) Change mulArrow to allow for printing of correct application precedence where necessary and update callers of mulArrow to reflect this. As part of this, move mulArrow from GHC/Utils/Outputtable to GHC/Iface/Type. Fixes #20315 - - - - - 30b8b7f1 by Ben Gamari at 2022-05-13T12:11:09-04:00 rts: Add debug output on ocResolve failure This makes it easier to see how resolution failures nest. - - - - - 53b3fa1c by Ben Gamari at 2022-05-13T12:11:09-04:00 rts/PEi386: Fix handling of weak symbols Previously we would flag the symbol as weak but failed to set its address, which must be computed from an "auxiliary" symbol entry the follows the weak symbol. Fixes #21556. - - - - - 5678f017 by Ben Gamari at 2022-05-13T12:11:09-04:00 testsuite: Add tests for #21556 - - - - - 49af0e52 by Ben Gamari at 2022-05-13T22:23:26-04:00 Re-export augment and build from GHC.List Resolves https://gitlab.haskell.org/ghc/ghc/-/issues/19127 - - - - - aed356e1 by Simon Peyton Jones at 2022-05-13T22:24:02-04:00 Comments only around HsWrapper - - - - - 27b90409 by Ben Gamari at 2022-05-16T08:30:44-04:00 hadrian: Introduce linting flavour transformer (+lint) The linting flavour enables -dlint uniformly across anything build by the stage1 compiler. -dcmm-lint is not currently enabled because it fails on i386 (see #21563) - - - - - 3f316776 by Matthew Pickering at 2022-05-16T08:30:44-04:00 hadrian: Uniformly enable -dlint with enableLinting transformer This fixes some bugs where * -dcore-lint was being passed when building stage1 libraries with the boot compiler * -dcore-lint was not being passed when building executables. Fixes #20135 - - - - - 3d74cfca by Andreas Klebinger at 2022-05-16T08:31:20-04:00 Make closure macros EXTERN_INLINE to make debugging easier Implements #21424. The RTS macros get_itbl and friends are extremely helpful during debugging. However only a select few of those were available in the compiled RTS as actual symbols as the rest were INLINE macros. This commit marks all of them as EXTERN_INLINE. This will still inline them at use sites but allow us to use their compiled counterparts during debugging. This allows us to use things like `p get_fun_itbl(ptr)` in the gdb shell since `get_fun_itbl` will now be available as symbol! - - - - - 93153aab by Matthew Pickering at 2022-05-16T08:31:55-04:00 packaging: Introduce CI job for generating hackage documentation This adds a CI job (hackage-doc-tarball) which generates the necessary tarballs for uploading libraries and documentation to hackage. The release script knows to download this folder and the upload script will also upload the release to hackage as part of the release. The `ghc_upload_libs` script is moved from ghc-utils into .gitlab/ghc_upload_libs There are two modes, preparation and upload. * The `prepare` mode takes a link to a bindist and creates a folder containing the source and doc tarballs ready to upload to hackage. * The `upload` mode takes the folder created by prepare and performs the upload to hackage. Fixes #21493 Related to #21512 - - - - - 65d31d05 by Simon Peyton Jones at 2022-05-16T15:32:50-04:00 Add arity to the INLINE pragmas for pattern synonyms The lack of INLNE arity was exposed by #21531. The fix is simple enough, if a bit clumsy. - - - - - 43c018aa by Krzysztof Gogolewski at 2022-05-16T15:33:25-04:00 Misc cleanup - Remove groupWithName (unused) - Use the RuntimeRepType synonym where possible - Replace getUniqueM + mkSysLocalOrCoVar with mkSysLocalOrCoVarM No functional changes. - - - - - 8dfea078 by Pavol Vargovcik at 2022-05-16T15:34:04-04:00 TcPlugin: access to irreducible givens + fix passed ev_binds_var - - - - - fb579e15 by Ben Gamari at 2022-05-17T00:25:02-04:00 driver: Introduce pgmcxx Here we introduce proper support for compilation of C++ objects. This includes: * logic in `configure` to detect the C++ toolchain and propagating this information into the `settings` file * logic in the driver to use the C++ toolchain when compiling C++ sources - - - - - 43628ed4 by Ben Gamari at 2022-05-17T00:25:02-04:00 testsuite: Build T20918 with HC, not CXX - - - - - 0ef249aa by Ben Gamari at 2022-05-17T00:25:02-04:00 Introduce package to capture dependency on C++ stdlib Here we introduce a new "virtual" package into the initial package database, `system-cxx-std-lib`. This gives users a convenient, platform agnostic way to link against C++ libraries, addressing #20010. Fixes #20010. - - - - - 03efe283 by Ben Gamari at 2022-05-17T00:25:02-04:00 testsuite: Add tests for system-cxx-std-lib package Test that we can successfully link against C++ code both in GHCi and batch compilation. See #20010 - - - - - 5f6527e0 by nineonine at 2022-05-17T00:25:38-04:00 OverloadedRecordFields: mention parent name in 'ambiguous occurrence' error for better disambiguation (#17420) - - - - - eccdb208 by Simon Peyton Jones at 2022-05-17T07:16:39-04:00 Adjust flags for pprTrace We were using defaultSDocContext for pprTrace, which suppresses lots of useful infomation. This small MR adds GHC.Utils.Outputable.traceSDocContext and uses it for pprTrace and pprTraceUserWarning. traceSDocContext is a global, and hence not influenced by flags, but that seems unavoidable. But I made the sdocPprDebug bit controlled by unsafeHasPprDebug, since we have the latter for exactly this purpose. Fixes #21569 - - - - - d2284c4c by Simon Peyton Jones at 2022-05-17T07:17:15-04:00 Fix bad interaction between withDict and the Specialiser This MR fixes a bad bug, where the withDict was inlined too vigorously, which in turn made the type-class Specialiser generate a bogus specialisation, because it saw the same overloaded function applied to two /different/ dictionaries. Solution: inline `withDict` later. See (WD8) of Note [withDict] in GHC.HsToCore.Expr See #21575, which is fixed by this change. - - - - - 70f52443 by Matthew Pickering at 2022-05-17T07:17:50-04:00 Bump time submodule to 1.12.2 This bumps the time submodule to the 1.12.2 release. Fixes #21571 - - - - - 2343457d by Vladislav Zavialov at 2022-05-17T07:18:26-04:00 Remove unused test files (#21582) Those files were moved to the perf/ subtree in 11c9a469, and then accidentally reintroduced in 680ef2c8. - - - - - cb52b4ae by Ben Gamari at 2022-05-17T16:00:14-04:00 CafAnal: Improve code clarity Here we implement a few measures to improve the clarity of the CAF analysis implementation. Specifically: * Use CafInfo instead of Bool since the former is more descriptive * Rename CAFLabel to CAFfyLabel, since not all CAFfyLabels are in fact CAFs * Add numerous comments - - - - - b048a9f4 by Ben Gamari at 2022-05-17T16:00:14-04:00 codeGen: Ensure that static datacon apps are included in SRTs When generating an SRT for a recursive group, GHC.Cmm.Info.Build.oneSRT filters out recursive references, as described in Note [recursive SRTs]. However, doing so for static functions would be unsound, for the reason described in Note [Invalid optimisation: shortcutting]. However, the same argument applies to static data constructor applications, as we discovered in #20959. Fix this by ensuring that static data constructor applications are included in recursive SRTs. The approach here is not entirely satisfactory, but it is a starting point. Fixes #20959. - - - - - 0e2d16eb by Matthew Pickering at 2022-05-17T16:00:50-04:00 Add test for #21558 This is now fixed on master and 9.2 branch. Closes #21558 - - - - - ef3c8d9e by Sylvain Henry at 2022-05-17T20:22:02-04:00 Don't store LlvmConfig into DynFlags LlvmConfig contains information read from llvm-passes and llvm-targets files in GHC's top directory. Reading these files is done only when needed (i.e. when the LLVM backend is used) and cached for the whole compiler session. This patch changes the way this is done: - Split LlvmConfig into LlvmConfig and LlvmConfigCache - Store LlvmConfigCache in HscEnv instead of DynFlags: there is no good reason to store it in DynFlags. As it is fixed per session, we store it in the session state instead (HscEnv). - Initializing LlvmConfigCache required some changes to driver functions such as newHscEnv. I've used the opportunity to untangle initHscEnv from initGhcMonad (in top-level GHC module) and to move it to GHC.Driver.Main, close to newHscEnv. - I've also made `cmmPipeline` independent of HscEnv in order to remove the call to newHscEnv in regalloc_unit_tests. - - - - - 828fbd8a by Andreas Klebinger at 2022-05-17T20:22:38-04:00 Give all EXTERN_INLINE closure macros prototypes - - - - - cfc8e2e2 by Ben Gamari at 2022-05-19T04:57:51-04:00 base: Introduce [sg]etFinalizerExceptionHandler This introduces a global hook which is called when an exception is thrown during finalization. - - - - - 372cf730 by Ben Gamari at 2022-05-19T04:57:51-04:00 base: Throw exceptions raised while closing finalized Handles Fixes #21336. - - - - - 3dd2f944 by Ben Gamari at 2022-05-19T04:57:51-04:00 testsuite: Add tests for #21336 - - - - - 297156e0 by Matthew Pickering at 2022-05-19T04:58:27-04:00 Add release flavour and use it for the release jobs The release flavour is essentially the same as the perf flavour currently but also enables `-haddock`. I have hopefully updated all the relevant places where the `-perf` flavour was hardcoded. Fixes #21486 - - - - - a05b6293 by Matthew Pickering at 2022-05-19T04:58:27-04:00 ci: Don't build sphinx documentation on centos The centos docker image lacks the sphinx builder so we disable building sphinx docs for these jobs. Fixes #21580 - - - - - 209d7c69 by Matthew Pickering at 2022-05-19T04:58:27-04:00 ci: Use correct syntax when args list is empty This seems to fail on the ancient version of bash present on CentOS - - - - - 02d16334 by Matthew Pickering at 2022-05-19T04:59:03-04:00 hadrian: Don't attempt to build dynamic profiling libraries We only support building static profiling libraries, the transformer was requesting things like a dynamic, threaded, debug, profiling RTS, which we have never produced nor distributed. Fixes #21567 - - - - - 35bdab1c by Ben Gamari at 2022-05-19T04:59:39-04:00 configure: Check CC_STAGE0 for --target support We previously only checked the stage 1/2 compiler for --target support. We got away with this for quite a while but it eventually caught up with us in #21579, where `bytestring`'s new NEON implementation was unbuildable on Darwin due to Rosetta's seemingly random logic for determining which executable image to execute. This lead to a confusing failure to build `bytestring`'s cbits, when `clang` tried to compile NEON builtins while targetting x86-64. Fix this by checking CC_STAGE0 for --target support. Fixes #21579. - - - - - 0ccca94b by Norman Ramsey at 2022-05-20T05:32:32-04:00 add dominator analysis of `CmmGraph` This commit adds module `GHC.Cmm.Dominators`, which provides a wrapper around two existing algorithms in GHC: the Lengauer-Tarjan dominator analysis from the X86 back end and the reverse postorder ordering from the Cmm Dataflow framework. Issue #20726 proposes that we evaluate some alternatives for dominator analysis, but for the time being, the best path forward is simply to use the existing analysis on `CmmGraph`s. This commit addresses a bullet in #21200. - - - - - 54f0b578 by Norman Ramsey at 2022-05-20T05:32:32-04:00 add dominator-tree function - - - - - 05ed917b by Norman Ramsey at 2022-05-20T05:32:32-04:00 add HasDebugCallStack; remove unneeded extensions - - - - - 0b848136 by Andreas Klebinger at 2022-05-20T05:32:32-04:00 document fields of `DominatorSet` - - - - - 8a26e8d6 by Ben Gamari at 2022-05-20T05:33:08-04:00 nonmoving: Fix documentation of GC statistics fields These were previously incorrect. Fixes #21553. - - - - - c1e24e61 by Matthew Pickering at 2022-05-20T05:33:44-04:00 Remove pprTrace from pushCoercionIntoLambda (#21555) This firstly caused spurious output to be emitted (as evidenced by #21555) but even worse caused a massive coercion to be attempted to be printed (> 200k terms) which would invariably eats up all the memory of your computer. The good news is that removing this trace allows the program to compile to completion, the bad news is that the program exhibits a core lint error (on 9.0.2) but not any other releases it seems. Fixes #21577 and #21555 - - - - - a36d12ee by Zubin Duggal at 2022-05-20T10:44:35-04:00 docs: Fix LlvmVersion in manpage (#21280) - - - - - 36b8a57c by Matthew Pickering at 2022-05-20T10:45:10-04:00 validate: Use $make rather than make In the validate script we are careful to use the $make variable as this stores whether we are using gmake, make, quiet mode etc. There was just this one place where we failed to use it. Fixes #21598 - - - - - 4aa3c5bd by Norman Ramsey at 2022-05-21T03:11:04+00:00 Change `Backend` type and remove direct dependencies With this change, `Backend` becomes an abstract type (there are no more exposed value constructors). Decisions that were formerly made by asking "is the current back end equal to (or different from) this named value constructor?" are now made by interrogating the back end about its properties, which are functions exported by `GHC.Driver.Backend`. There is a description of how to migrate code using `Backend` in the user guide. Clients using the GHC API can find a backdoor to access the Backend datatype in GHC.Driver.Backend.Internal. Bumps haddock submodule. Fixes #20927 - - - - - ecf5f363 by Julian Ospald at 2022-05-21T12:51:16-04:00 Respect DESTDIR in hadrian bindist Makefile, fixes #19646 - - - - - 7edd991e by Julian Ospald at 2022-05-21T12:51:16-04:00 Test DESTDIR in test_hadrian() - - - - - ea895b94 by Matthew Pickering at 2022-05-22T21:57:47-04:00 Consider the stage of typeable evidence when checking stage restriction We were considering all Typeable evidence to be "BuiltinInstance"s which meant the stage restriction was going unchecked. In-fact, typeable has evidence and so we need to apply the stage restriction. This is complicated by the fact we don't generate typeable evidence and the corresponding DFunIds until after typechecking is concluded so we introcue a new `InstanceWhat` constructor, BuiltinTypeableInstance which records whether the evidence is going to be local or not. Fixes #21547 - - - - - ffbe28e5 by Dominik Peteler at 2022-05-22T21:58:23-04:00 Modularize GHC.Core.Opt.LiberateCase Progress towards #17957 - - - - - bc723ac2 by Simon Peyton Jones at 2022-05-23T17:09:34+01:00 Improve FloatOut and SpecConstr This patch addresses a relatively obscure situation that arose when chasing perf regressions in !7847, which itself is fixing It does two things: * SpecConstr can specialise on ($df d1 d2) dictionary arguments * FloatOut no longer checks argument strictness See Note [Specialising on dictionaries] in GHC.Core.Opt.SpecConstr. A test case is difficult to construct, but it makes a big difference in nofib/real/eff/VSM, at least when we have the patch for #21286 installed. (The latter stops worker/wrapper for dictionary arguments). There is a spectacular, but slightly illusory, improvement in runtime perf on T15426. I have documented the specifics in T15426 itself. Metric Decrease: T15426 - - - - - 1a4195b0 by John Ericson at 2022-05-23T17:33:59-04:00 Make debug a `Bool` not an `Int` in `StgToCmmConfig` We don't need any more resolution than this. Rename the field to `stgToCmmEmitDebugInfo` to indicate it is no longer conveying any "level" information. - - - - - e9fff12b by Alan Zimmerman at 2022-05-23T21:04:49-04:00 EPA : Remove duplicate comments in DataFamInstD The code data instance Method PGMigration = MigrationQuery Query -- ^ Run a query against the database | MigrationCode (Connection -> IO (Either String ())) -- ^ Run any arbitrary IO code Resulted in two instances of the "-- ^ Run a query against the database" comment appearing in the Exact Print Annotations when it was parsed. Ensure only one is kept. Closes #20239 - - - - - e2520df3 by Alan Zimmerman at 2022-05-23T21:05:27-04:00 EPA: Comment Order Reversed Make sure comments captured in the exact print annotations are in order of increasing location Closes #20718 - - - - - 4b45fd72 by Teo Camarasu at 2022-05-24T10:49:13-04:00 Add test for T21455 - - - - - e2cd1d43 by Teo Camarasu at 2022-05-24T10:49:13-04:00 Allow passing -po outside profiling way Resolves #21455 - - - - - 3b8c413a by Greg Steuck at 2022-05-24T10:49:52-04:00 Fix haddock_*_perf tests on non-GNU-grep systems Using regexp pattern requires `egrep` and straight up `+`. The haddock_parser_perf and haddock_renamer_perf tests now pass on OpenBSD. They previously incorrectly parsed the files and awk complained about invalid syntax. - - - - - 1db877a3 by Ben Gamari at 2022-05-24T10:50:28-04:00 hadrian/bindist: Drop redundant include of install.mk `install.mk` is already included by `config.mk`. Moreover, `install.mk` depends upon `config.mk` to set `RelocatableBuild`, making this first include incorrect. - - - - - f485d267 by Greg Steuck at 2022-05-24T10:51:08-04:00 Remove -z wxneeded for OpenBSD With all the recent W^X fixes in the loader this workaround is not necessary any longer. I verified that the only tests failing for me on OpenBSD 7.1-current are the same (libc++ related) before and after this commit (with --fast). - - - - - 7c51177d by Andreas Klebinger at 2022-05-24T22:13:19-04:00 Use UnionListsOrd instead of UnionLists in most places. This should get rid of most, if not all "Overlong lists" errors and fix #20016 - - - - - 81b3741f by Andreas Klebinger at 2022-05-24T22:13:55-04:00 Fix #21563 by using Word64 for 64bit shift code. We use the 64bit shifts only on 64bit platforms. But we compile the code always so compiling it on 32bit caused a lint error. So use Word64 instead. - - - - - 2c25fff6 by Zubin Duggal at 2022-05-24T22:14:30-04:00 Fix compilation with -haddock on GHC <= 8.10 -haddock on GHC < 9.0 is quite fragile and can result in obtuse parse errors when it encounters invalid haddock syntax. This has started to affect users since 297156e0b8053a28a860e7a18e1816207a59547b enabled -haddock by default on many flavours. Furthermore, since we don't test bootstrapping with 8.10 on CI, this problem managed to slip throught the cracks. - - - - - cfb9faff by sheaf at 2022-05-24T22:15:12-04:00 Hadrian: don't add "lib" for relocatable builds The conditional in hadrian/bindist/Makefile depended on the target OS, but it makes more sense to use whether we are using a relocatable build. (Currently this only gets set to true on Windows, but this ensures that the logic stays correctly coupled.) - - - - - 9973c016 by Andre Marianiello at 2022-05-25T01:36:09-04:00 Remove HscEnv from GHC.HsToCore.Usage (related to #17957) Metric Decrease: T16875 - - - - - 2ff18e39 by sheaf at 2022-05-25T01:36:48-04:00 SimpleOpt: beta-reduce through casts The simple optimiser would sometimes fail to beta-reduce a lambda when there were casts in between the lambda and its arguments. This can cause problems because we rely on representation-polymorphic lambdas getting beta-reduced away (for example, those that arise from newtype constructors with representation-polymorphic arguments, with UnliftedNewtypes). - - - - - e74fc066 by CarrieMY at 2022-05-25T16:43:03+02:00 Desugar RecordUpd in `tcExpr` This patch typechecks record updates by desugaring them inside the typechecker using the HsExpansion mechanism, and then typechecking this desugared result. Example: data T p q = T1 { x :: Int, y :: Bool, z :: Char } | T2 { v :: Char } | T3 { x :: Int } | T4 { p :: Float, y :: Bool, x :: Int } | T5 The record update `e { x=e1, y=e2 }` desugars as follows e { x=e1, y=e2 } ===> let { x' = e1; y' = e2 } in case e of T1 _ _ z -> T1 x' y' z T4 p _ _ -> T4 p y' x' The desugared expression is put into an HsExpansion, and we typecheck that. The full details are given in Note [Record Updates] in GHC.Tc.Gen.Expr. Fixes #2595 #3632 #10808 #10856 #16501 #18311 #18802 #21158 #21289 Updates haddock submodule - - - - - 2b8bdab8 by Eric Lindblad at 2022-05-26T03:21:58-04:00 update README - - - - - 3d7e7e84 by BinderDavid at 2022-05-26T03:22:38-04:00 Replace dead link in Haddock documentation of Control.Monad.Fail (fixes #21602) - - - - - ee61c7f9 by John Ericson at 2022-05-26T03:23:13-04:00 Add Haddocks for `WwOpts` - - - - - da5ccf0e by Dominik Peteler at 2022-05-26T03:23:13-04:00 Avoid global compiler state for `GHC.Core.Opt.WorkWrap` Progress towards #17957 - - - - - 3bd975b4 by sheaf at 2022-05-26T03:23:52-04:00 Optimiser: avoid introducing bad rep-poly The functions `pushCoValArg` and `pushCoercionIntoLambda` could introduce bad representation-polymorphism. Example: type RR :: RuntimeRep type family RR where { RR = IntRep } type F :: TYPE RR type family F where { F = Int# } co = GRefl F (TYPE RR[0]) :: (F :: TYPE RR) ~# (F |> TYPE RR[0] :: TYPE IntRep) f :: F -> () `pushCoValArg` would transform the unproblematic application (f |> (co -> <()>)) (arg :: F |> TYPE RR[0]) into an application in which the argument does not have a fixed `RuntimeRep`: f ((arg |> sym co) :: (F :: TYPE RR)) - - - - - b22979fb by Fraser Tweedale at 2022-05-26T06:14:51-04:00 executablePath test: fix file extension treatment The executablePath test strips the file extension (if any) when comparing the query result with the expected value. This is to handle platforms where GHC adds a file extension to the output program file (e.g. .exe on Windows). After the initial check, the file gets deleted (if supported). However, it tries to delete the *stripped* filename, which is incorrect. The test currently passes only because Windows does not allow deleting the program while any process created from it is alive. Make the test program correct in general by deleting the *non-stripped* executable filename. - - - - - afde4276 by Fraser Tweedale at 2022-05-26T06:14:51-04:00 fix executablePath test for NetBSD executablePath support for NetBSD was added in a172be07e3dce758a2325104a3a37fc8b1d20c9c, but the test was not updated. Update the test so that it works for NetBSD. This requires handling some quirks: - The result of getExecutablePath could include "./" segments. Therefore use System.FilePath.equalFilePath to compare paths. - The sysctl(2) call returns the original executable name even after it was deleted. Add `canQueryAfterDelete :: [FilePath]` and adjust expectations for the post-delete query accordingly. Also add a note to the `executablePath` haddock to advise that NetBSD behaves differently from other OSes when the file has been deleted. Also accept a decrease in memory usage for T16875. On Windows, the metric is -2.2% of baseline, just outside the allowed ±2%. I don't see how this commit could have influenced this metric, so I suppose it's something in the CI environment. Metric Decrease: T16875 - - - - - d0e4355a by John Ericson at 2022-05-26T06:15:30-04:00 Factor out `initArityOps` to `GHC.Driver.Config.*` module We want `DynFlags` only mentioned in `GHC.Driver`. - - - - - 44bb7111 by romes at 2022-05-26T16:27:57+00:00 TTG: Move MatchGroup Origin field and MatchGroupTc to GHC.Hs - - - - - 88e58600 by sheaf at 2022-05-26T17:38:43-04:00 Add tests for eta-expansion of data constructors This patch adds several tests relating to the eta-expansion of data constructors, including UnliftedNewtypes and DataTypeContexts. - - - - - d87530bb by Richard Eisenberg at 2022-05-26T23:20:14-04:00 Generalize breakTyVarCycle to work with TyFamLHS The function breakTyVarCycle_maybe has been installed in a dark corner of GHC to catch some gremlins (a.k.a. occurs-check failures) who lurk there. But it previously only caught gremlins of the form (a ~ ... F a ...), where some of our intrepid users have spawned gremlins of the form (G a ~ ... F (G a) ...). This commit improves breakTyVarCycle_maybe (and renames it to breakTyEqCycle_maybe) to catch the new gremlins. Happily, the change is remarkably small. The gory details are in Note [Type equality cycles]. Test cases: typecheck/should_compile/{T21515,T21473}. - - - - - ed37027f by Hécate Moonlight at 2022-05-26T23:20:52-04:00 [base] Fix the links in the Data.Data module fix #21658 fix #21657 fix #21657 - - - - - 3bd7d5d6 by Krzysztof Gogolewski at 2022-05-27T16:44:48+02:00 Use a class to check validity of withDict This moves handling of the magic 'withDict' function from the desugarer to the typechecker. Details in Note [withDict]. I've extracted a part of T16646Fail to a separate file T16646Fail2, because the new error in 'reify' hides the errors from 'f' and 'g'. WithDict now works with casts, this fixes #21328. Part of #19915 - - - - - b54f6c4f by sheaf at 2022-05-28T21:00:09-04:00 Fix FreeVars computation for mdo Commit acb188e0 introduced a regression in the computation of free variables in mdo statements, as the logic in GHC.Rename.Expr.segmentRecStmts was slightly different depending on whether the recursive do block corresponded to an mdo statement or a rec statment. This patch restores the previous computation for mdo blocks. Fixes #21654 - - - - - 0704295c by Matthew Pickering at 2022-05-28T21:00:45-04:00 T16875: Stabilise (temporarily) by increasing acceptance threshold The theory is that on windows there is some difference in the environment between pipelines on master and merge requests which affects all tests equally but because T16875 barely allocates anything it is the test which is affected the most. See #21557 - - - - - 6341c8ed by Matthew Pickering at 2022-05-28T21:01:20-04:00 make: Fix make maintainer-clean deleting a file tracked by source control Fixes #21659 - - - - - fbf2f254 by Bodigrim at 2022-05-28T21:01:58-04:00 Expand documentation of hIsTerminalDevice - - - - - 0092c67c by Teo Camarasu at 2022-05-29T12:25:39+00:00 export IsList from GHC.IsList it is still re-exported from GHC.Exts - - - - - 91396327 by Sylvain Henry at 2022-05-30T09:40:55-04:00 MachO linker: fix handling of ARM64_RELOC_SUBTRACTOR ARM64_RELOC_SUBTRACTOR relocations are paired with an AMR64_RELOC_UNSIGNED relocation to implement: addend + sym1 - sym2 The linker was doing it in two steps, basically: *addend <- *addend - sym2 *addend <- *addend + sym1 The first operation was likely to overflow. For example when the relocation target was 32-bit and both sym1/sym2 were 64-bit addresses. With the small memory model, (sym1-sym2) would fit in 32 bits but (*addend-sym2) may not. Now the linker does it in one step: *addend <- *addend + sym1 - sym2 - - - - - acc26806 by Sylvain Henry at 2022-05-30T09:40:55-04:00 Some fixes to SRT documentation - reordered the 3 SRT implementation cases from the most general to the most specific one: USE_SRT_POINTER -> USE_SRT_OFFSET -> USE_INLINE_SRT_FIELD - added requirements for each - found and documented a confusion about "SRT inlining" not supported with MachO. (It is fixed in the following commit) - - - - - 5878f439 by Sylvain Henry at 2022-05-30T09:40:55-04:00 Enable USE_INLINE_SRT_FIELD on ARM64 It was previously disabled because of: - a confusion about "SRT inlining" (see removed comment in this commit) - a linker bug (overflow) in the handling of ARM64_RELOC_SUBTRACTOR relocation: fixed by a previous commit. - - - - - 59bd6159 by Matthew Pickering at 2022-05-30T09:41:39-04:00 ci: Make sure to exit promptly if `make install` fails. Due to the vageries of bash, you have to explicitly handle the failure and exit when in a function. This failed to exit promptly when !8247 was failing. See #21358 for the general issue - - - - - 5a5a28da by Sylvain Henry at 2022-05-30T09:42:23-04:00 Split GHC.HsToCore.Foreign.Decl This is preliminary work for JavaScript support. It's better to put the code handling the desugaring of Prim, C and JavaScript declarations into separate modules. - - - - - 6f5ff4fa by Sylvain Henry at 2022-05-30T09:43:05-04:00 Bump hadrian to LTS-19.8 (GHC 9.0.2) - - - - - f2e70707 by Sylvain Henry at 2022-05-30T09:43:05-04:00 Hadrian: remove unused code - - - - - 2f215b9f by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Eta reduction with casted function We want to be able to eta-reduce \x y. ((f x) |> co) y by pushing 'co' inwards. A very small change accommodates this See Note [Eta reduction with casted function] - - - - - f4f6a87a by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Do arity trimming at bindings, rather than in exprArity Sometimes there are very large casts, and coercionRKind can be slow. - - - - - 610a2b83 by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Make findRhsArity take RecFlag This avoids a fixpoint iteration for the common case of non-recursive bindings. - - - - - 80ba50c7 by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Comments and white space - - - - - 0079171b by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Make PrimOpId record levity This patch concerns #20155, part (1) The general idea is that since primops have curried bindings (currently in PrimOpWrappers.hs) we don't need to eta-expand them. But we /do/ need to eta-expand the levity-polymorphic ones, because they /don't/ have bindings. This patch makes a start in that direction, by identifying the levity-polymophic primops in the PrimOpId IdDetails constructor. For the moment, I'm still eta-expanding all primops (by saying that hasNoBinding returns True for all primops), because of the bug reported in #20155. But I hope that before long we can tidy that up too, and remove the TEMPORARILY stuff in hasNoBinding. - - - - - 6656f016 by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: * Move state-hack stuff from GHC.Types.Id (where it never belonged) to GHC.Core.Opt.Arity (which seems much more appropriate). * Add a crucial mkCast in the Cast case of GHC.Core.Opt.Arity.eta_expand; helps with T18223 * Add clarifying notes about eta-reducing to PAPs. See Note [Do not eta reduce PAPs] * I moved tryEtaReduce from GHC.Core.Utils to GHC.Core.Opt.Arity, where it properly belongs. See Note [Eta reduce PAPs] * In GHC.Core.Opt.Simplify.Utils.tryEtaExpandRhs, pull out the code for when eta-expansion is wanted, to make wantEtaExpansion, and all that same function in GHC.Core.Opt.Simplify.simplStableUnfolding. It was previously inconsistent, but it's doing the same thing. * I did a substantial refactor of ArityType; see Note [ArityType]. This allowed me to do away with the somewhat mysterious takeOneShots; more generally it allows arityType to describe the function, leaving its clients to decide how to use that information. I made ArityType abstract, so that clients have to use functions to access it. * Make GHC.Core.Opt.Simplify.Utils.rebuildLam (was stupidly called mkLam before) aware of the floats that the simplifier builds up, so that it can still do eta-reduction even if there are some floats. (Previously that would not happen.) That means passing the floats to rebuildLam, and an extra check when eta-reducting (etaFloatOk). * In GHC.Core.Opt.Simplify.Utils.tryEtaExpandRhs, make use of call-info in the idDemandInfo of the binder, as well as the CallArity info. The occurrence analyser did this but we were failing to take advantage here. In the end I moved the heavy lifting to GHC.Core.Opt.Arity.findRhsArity; see Note [Combining arityType with demand info], and functions idDemandOneShots and combineWithDemandOneShots. (These changes partly drove my refactoring of ArityType.) * In GHC.Core.Opt.Arity.findRhsArity * I'm now taking account of the demand on the binder to give extra one-shot info. E.g. if the fn is always called with two args, we can give better one-shot info on the binders than if we just look at the RHS. * Don't do any fixpointing in the non-recursive case -- simple short cut. * Trim arity inside the loop. See Note [Trim arity inside the loop] * Make SimpleOpt respect the eta-reduction flag (Some associated refactoring here.) * I made the CallCtxt which the Simplifier uses distinguish between recursive and non-recursive right-hand sides. data CallCtxt = ... | RhsCtxt RecFlag | ... It affects only one thing: - We call an RHS context interesting only if it is non-recursive see Note [RHS of lets] in GHC.Core.Unfold * Remove eta-reduction in GHC.CoreToStg.Prep, a welcome simplification. See Note [No eta reduction needed in rhsToBody] in GHC.CoreToStg.Prep. Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. * Delete dead function GHC.Core.Opt.Simplify.Utils.contIsRhsOrArg Metrics: compile_time/bytes allocated Test Metric Baseline New value Change --------------------------------------------------------------------------------------- MultiLayerModulesTH_OneShot(normal) ghc/alloc 2,743,297,692 2,619,762,992 -4.5% GOOD T18223(normal) ghc/alloc 1,103,161,360 972,415,992 -11.9% GOOD T3064(normal) ghc/alloc 201,222,500 184,085,360 -8.5% GOOD T8095(normal) ghc/alloc 3,216,292,528 3,254,416,960 +1.2% T9630(normal) ghc/alloc 1,514,131,032 1,557,719,312 +2.9% BAD parsing001(normal) ghc/alloc 530,409,812 525,077,696 -1.0% geo. mean -0.1% Nofib: Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- banner +0.0% +0.4% -8.9% -8.7% 0.0% exact-reals +0.0% -7.4% -36.3% -37.4% 0.0% fannkuch-redux +0.0% -0.1% -1.0% -1.0% 0.0% fft2 -0.1% -0.2% -17.8% -19.2% 0.0% fluid +0.0% -1.3% -2.1% -2.1% 0.0% gg -0.0% +2.2% -0.2% -0.1% 0.0% spectral-norm +0.1% -0.2% 0.0% 0.0% 0.0% tak +0.0% -0.3% -9.8% -9.8% 0.0% x2n1 +0.0% -0.2% -3.2% -3.2% 0.0% -------------------------------------------------------------------------------- Min -3.5% -7.4% -58.7% -59.9% 0.0% Max +0.1% +2.2% +32.9% +32.9% 0.0% Geometric Mean -0.0% -0.1% -14.2% -14.8% -0.0% Metric Decrease: MultiLayerModulesTH_OneShot T18223 T3064 T15185 T14766 Metric Increase: T9630 - - - - - cac8c7bb by Matthew Pickering at 2022-05-30T13:44:50-04:00 hadrian: Fix building from source-dist without alex/happy This fixes two bugs which were adding dependencies on alex/happy when building from a source dist. * When we try to pass `--with-alex` and `--with-happy` to cabal when configuring but the builders are not set. This is fixed by making them optional. * When we configure, cabal requires alex/happy because of the build-tool-depends fields. These are now made optional with a cabal flag (build-tool-depends) for compiler/hpc-bin/genprimopcode. Fixes #21627 - - - - - a96dccfe by Matthew Pickering at 2022-05-30T13:44:50-04:00 ci: Test the bootstrap without ALEX/HAPPY on path - - - - - 0e5bb3a8 by Matthew Pickering at 2022-05-30T13:44:50-04:00 ci: Test bootstrapping in release jobs - - - - - d8901469 by Matthew Pickering at 2022-05-30T13:44:50-04:00 ci: Allow testing bootstrapping on MRs using the "test-bootstrap" label - - - - - 18326ad2 by Matthew Pickering at 2022-05-30T13:45:25-04:00 rts: Remove explicit timescale for deprecating -h flag We originally planned to remove the flag in 9.4 but there's actually no great rush to do so and it's probably less confusing (forever) to keep the message around suggesting an explicit profiling option. Fixes #21545 - - - - - eaaa1389 by Matthew Pickering at 2022-05-30T13:46:01-04:00 Enable -dlint in hadrian lint transformer Now #21563 is fixed we can properly enable `-dlint` in CI rather than a subset of the flags. - - - - - 0544f114 by Ben Gamari at 2022-05-30T19:16:55-04:00 upload-ghc-libs: Allow candidate-only upload - - - - - 83467435 by Sylvain Henry at 2022-05-30T19:17:35-04:00 Avoid using DynFlags in GHC.Linker.Unit (#17957) - - - - - 5c4421b1 by Matthew Pickering at 2022-05-31T08:35:17-04:00 hadrian: Introduce new package database for executables needed to build stage0 These executables (such as hsc2hs) are built using the boot compiler and crucially, most libraries from the global package database. We also move other build-time executables to be built in this stage such as linters which also cleans up which libraries end up in the global package database. This allows us to remove hacks where linters-common is removed from the package database when a bindist is created. This fixes issues caused by infinite recursion due to bytestring adding a dependency on template-haskell. Fixes #21634 - - - - - 0dafd3e7 by Matthew Pickering at 2022-05-31T08:35:17-04:00 Build stage1 with -V as well This helps tracing errors which happen when building stage1 - - - - - 15d42a7a by Matthew Pickering at 2022-05-31T08:35:52-04:00 Revert "packaging: Build perf builds with -split-sections" This reverts commit 699f593532a3cd5ca1c2fab6e6e4ce9d53be2c1f. Split sections causes segfaults in profiling way with old toolchains (deb9) and on windows (#21670) Fixes #21670 - - - - - d4c71f09 by John Ericson at 2022-05-31T16:26:28+00:00 Purge `DynFlags` and `HscEnv` from some `GHC.Core` modules where it's not too hard Progress towards #17957 Because of `CoreM`, I did not move the `DynFlags` and `HscEnv` to other modules as thoroughly as I usually do. This does mean that risk of `DynFlags` "creeping back in" is higher than it usually is. After we do the same process to the other Core passes, and then figure out what we want to do about `CoreM`, we can finish the job started here. That is a good deal more work, however, so it certainly makes sense to land this now. - - - - - a720322f by romes at 2022-06-01T07:44:44-04:00 Restore Note [Quasi-quote overview] - - - - - 392ce3fc by romes at 2022-06-01T07:44:44-04:00 Move UntypedSpliceFlavour from L.H.S to GHC.Hs UntypedSpliceFlavour was only used in the client-specific `GHC.Hs.Expr` but was defined in the client-independent L.H.S.Expr. - - - - - 7975202b by romes at 2022-06-01T07:44:44-04:00 TTG: Rework and improve splices This commit redefines the structure of Splices in the AST. We get rid of `HsSplice` which used to represent typed and untyped splices, quasi quotes, and the result of splicing either an expression, a type or a pattern. Instead we have `HsUntypedSplice` which models an untyped splice or a quasi quoter, which works in practice just like untyped splices. The `HsExpr` constructor `HsSpliceE` which used to be constructed with an `HsSplice` is split into `HsTypedSplice` and `HsUntypedSplice`. The former is directly constructed with an `HsExpr` and the latter now takes an `HsUntypedSplice`. Both `HsType` and `Pat` constructors `HsSpliceTy` and `SplicePat` now take an `HsUntypedSplice` instead of a `HsSplice` (remember only /untyped splices/ can be spliced as types or patterns). The result of splicing an expression, type, or pattern is now comfortably stored in the extension fields `XSpliceTy`, `XSplicePat`, `XUntypedSplice` as, respectively, `HsUntypedSpliceResult (HsType GhcRn)`, `HsUntypedSpliceResult (Pat GhcRn)`, and `HsUntypedSpliceResult (HsExpr GhcRn)` Overall the TTG extension points are now better used to make invalid states unrepresentable and model the progression between stages better. See Note [Lifecycle of an untyped splice, and PendingRnSplice] and Note [Lifecycle of an typed splice, and PendingTcSplice] for more details. Updates haddock submodule Fixes #21263 ------------------------- Metric Decrease: hard_hole_fits ------------------------- - - - - - 320270c2 by Matthew Pickering at 2022-06-01T07:44:44-04:00 Add test for #21619 Fixes #21619 - - - - - ef7ddd73 by Pierre Le Marre at 2022-06-01T07:44:47-04:00 Pure Haskell implementation of GHC.Unicode Switch to a pure Haskell implementation of base:GHC.Unicode, based on the implementation of the package unicode-data (https://github.com/composewell/unicode-data/). Approved by CLC as per https://github.com/haskell/core-libraries-committee/issues/59#issuecomment-1132106691. - Remove current Unicode cbits. - Add generator for Unicode property files from Unicode Character Database. - Generate internal modules. - Update GHC.Unicode. - Add unicode003 test for general categories and case mappings. - Add Python scripts to check 'base' Unicode tests outputs and characters properties. Fixes #21375 ------------------------- Metric Decrease: T16875 Metric Increase: T4029 T18304 haddock.base ------------------------- - - - - - 514a6a28 by Eric Lindblad at 2022-06-01T07:44:51-04:00 typos - - - - - 9004be3c by Matthew Pickering at 2022-06-01T07:44:52-04:00 source-dist: Copy in files created by ./boot Since we started producing source dists with hadrian we stopped copying in the files created by ./boot which adds a dependency on python3 and autoreconf. This adds back in the files which were created by running configure. Fixes #21673 #21672 and #21626 - - - - - a12a3cab by Matthew Pickering at 2022-06-01T07:44:52-04:00 ci: Don't try to run ./boot when testing bootstrap of source dist - - - - - e07f9059 by Shlomo Shuck at 2022-06-01T07:44:55-04:00 Language.Haskell.Syntax: Fix docs for PromotedConsT etc. Fixes ghc/ghc#21675. - - - - - 87295e6d by Ben Gamari at 2022-06-01T07:44:56-04:00 Bump bytestring, process, and text submodules Metric Decrease: T5631 Metric Increase: T18223 (cherry picked from commit 55fcee30cb3281a66f792e8673967d64619643af) - - - - - 24b5bb61 by Ben Gamari at 2022-06-01T07:44:56-04:00 Bump Cabal submodule To current `master`. (cherry picked from commit fbb59c212415188486aafd970eafef170516356a) - - - - - 5433a35e by Matthew Pickering at 2022-06-01T22:26:30-04:00 hadrian/tool-args: Write output to intermediate file rather than via stdout This allows us to see the output of hadrian while it is doing the setup. - - - - - 468f919b by Matthew Pickering at 2022-06-01T22:27:10-04:00 Make -fcompact-unwind the default This is a follow-up to !7247 (closed) making the inclusion of compact unwinding sections the default. Also a slight refactoring/simplification of the flag handling to add -fno-compact-unwind. - - - - - 819fdc61 by Zubin Duggal at 2022-06-01T22:27:47-04:00 hadrian bootstrap: add plans for 9.0.2 and 9.2.3 - - - - - 9fa790b4 by Zubin Duggal at 2022-06-01T22:27:47-04:00 ci: Add matrix for bootstrap sources - - - - - ce9f986b by John Ericson at 2022-06-02T15:42:59+00:00 HsToCore.Coverage: Improve haddocks - - - - - f065804e by John Ericson at 2022-06-02T15:42:59+00:00 Hoist auto `mkModBreaks` and `writeMixEntries` conditions to caller No need to inline traversing a maybe for `mkModBreaks`. And better to make each function do one thing and let the caller deside when than scatter the decision making and make the caller seem more imperative. - - - - - d550d907 by John Ericson at 2022-06-02T15:42:59+00:00 Rename `HsToCore.{Coverage -> Ticks}` The old name made it confusing why disabling HPC didn't disable the entire pass. The name makes it clear --- there are other reasons to add ticks in addition. - - - - - 6520da95 by John Ericson at 2022-06-02T15:42:59+00:00 Split out `GHC.HsToCore.{Breakpoints,Coverage}` and use `SizedSeq` As proposed in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7508#note_432877 and https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7508#note_434676, `GHC.HsToCore.Ticks` is about ticks, breakpoints are separate and backend-specific (only for the bytecode interpreter), and mix entry writing is just for HPC. With this split we separate out those interpreter- and HPC-specific its, and keep the main `GHC.HsToCore.Ticks` agnostic. Also, instead of passing the reversed list and count around, we use `SizedSeq` which abstracts over the algorithm. This is much nicer to avoid noise and prevents bugs. (The bugs are not just hypothetical! I missed up the reverses on an earlier draft of this commit.) - - - - - 1838c3d8 by Sylvain Henry at 2022-06-02T15:43:14+00:00 GHC.HsToCore.Breakpoints: Slightly improve perf We have the length already, so we might as well use that rather than O(n) recomputing it. - - - - - 5a3fdcfd by John Ericson at 2022-06-02T15:43:59+00:00 HsToCore.Coverage: Purge DynFlags Finishes what !7467 (closed) started. Progress towards #17957 - - - - - 9ce9ea50 by HaskellMouse at 2022-06-06T09:50:00-04:00 Deprecate TypeInType extension This commit fixes #20312 It deprecates "TypeInType" extension according to the following proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0083-no-type-in-type.rst It has been already implemented. The migration strategy: 1. Disable TypeInType 2. Enable both DataKinds and PolyKinds extensions Metric Decrease: T16875 - - - - - f2e037fd by Aaron Allen at 2022-06-06T09:50:39-04:00 Diagnostics conversions, part 6 (#20116) Replaces uses of `TcRnUnknownMessage` with proper diagnostics constructors in `GHC.Tc.Gen.Match`, `GHC.Tc.Gen.Pat`, and `GHC.Tc.Gen.Sig`. - - - - - 04209f2a by Simon Peyton Jones at 2022-06-06T09:51:15-04:00 Ensure floated dictionaries are in scope (again) In the Specialiser, we missed one more call to bringFloatedDictsIntoScope (see #21391). This omission led to #21689. The problem is that the call to `rewriteClassOps` needs to have in scope any dictionaries floated out of the arguments we have just specialised. Easy fix. - - - - - a7fece19 by John Ericson at 2022-06-07T05:04:22+00:00 Don't print the number of deps in count-deps tests It is redundant information and a source of needless version control conflicts when multiple MRs are changing the deps list. Just printing the list and not also its length is fine. - - - - - a1651a3a by John Ericson at 2022-06-07T05:06:38+00:00 Core.Lint: Reduce `DynFlags` and `HscEnv` Co-Authored-By: Andre Marianiello <andremarianiello at users.noreply.github.com> - - - - - 56ebf9a5 by Andreas Klebinger at 2022-06-09T09:11:43-04:00 Fix a CSE shadowing bug. We used to process the rhs of non-recursive bindings and their body using the same env. If we had something like let x = ... x ... this caused trouble because the two xs refer to different binders but we would substitute both for a new binder x2 causing out of scope errors. We now simply use two different envs for the rhs and body in cse_bind. It's all explained in the Note [Separate envs for let rhs and body] Fixes #21685 - - - - - 28880828 by sheaf at 2022-06-09T09:12:19-04:00 Typecheck remaining ValArgs in rebuildHsApps This patch refactors hasFixedRuntimeRep_remainingValArgs, renaming it to tcRemainingValArgs. The logic is moved to rebuildHsApps, which ensures consistent behaviour across tcApp and quickLookArg1/tcEValArg. This patch also refactors the treatment of stupid theta for data constructors, changing the place we drop stupid theta arguments from dsConLike to mkDataConRep (now the datacon wrapper drops these arguments). We decided not to implement PHASE 2 of the FixedRuntimeRep plan for these remaining ValArgs. Future directions are outlined on the wiki: https://gitlab.haskell.org/ghc/ghc/-/wikis/Remaining-ValArgs Fixes #21544 and #21650 - - - - - 1fbba97b by Matthew Pickering at 2022-06-09T09:12:54-04:00 Add test for T21682 Fixes #21682 - - - - - 8727be73 by Andreas Klebinger at 2022-06-09T09:13:29-04:00 Document dataToTag# primop - - - - - 7eab75bb by uhbif19 at 2022-06-09T20:22:47+03:00 Remove TcRnUnknownMessage usage from GHC.Rename.Env #20115 - - - - - 46d2fc65 by uhbif19 at 2022-06-09T20:24:40+03:00 Fix TcRnPragmaWarning meaning - - - - - 69e72ecd by Matthew Pickering at 2022-06-09T19:07:01-04:00 getProcessCPUTime: Fix the getrusage fallback to account for system CPU time clock_gettime reports the combined total or user AND system time so in order to replicate it with getrusage we need to add both system and user time together. See https://stackoverflow.com/questions/7622371/getrusage-vs-clock-gettime Some sample measurements when building Cabal with this patch t1: rusage t2: clock_gettime t1: 62347518000; t2: 62347520873 t1: 62395687000; t2: 62395690171 t1: 62432435000; t2: 62432437313 t1: 62478489000; t2: 62478492465 t1: 62514990000; t2: 62514992534 t1: 62515479000; t2: 62515480327 t1: 62515485000; t2: 62515486344 Fixes #21656 - - - - - 722814ba by Yiyun Liu at 2022-06-10T21:23:03-04:00 Use <br> instead of newline character - - - - - dc202080 by Matthew Craven at 2022-06-13T14:07:12-04:00 Use (fixed_lev = True) in mkDataTyConRhs - - - - - ad70c621 by Matthew Pickering at 2022-06-14T08:40:53-04:00 hadrian: Fix testing stage1 compiler There were various issues with testing the stage1 compiler.. 1. The wrapper was not being built 2. The wrapper was picking up the stage0 package database and trying to load prelude from that. 3. The wrappers never worked on windows so just don't support that for now. Fixes #21072 - - - - - ac83899d by Ben Gamari at 2022-06-14T08:41:30-04:00 validate: Ensure that $make variable is set Currently the `$make` variable is used without being set in `validate`'s Hadrian path, which uses make to install the binary distribution. Fix this. Fixes #21687. - - - - - 59bc6008 by John Ericson at 2022-06-15T18:05:35+00:00 CoreToStg.Prep: Get rid of `DynFlags` and `HscEnv` The call sites in `Driver.Main` are duplicative, but this is good, because the next step is to remove `InteractiveContext` from `Core.Lint` into `Core.Lint.Interactive`. Also further clean up `Core.Lint` to use a better configuration record than the one we initially added. - - - - - aa9d9381 by Ben Gamari at 2022-06-15T20:33:04-04:00 hadrian: Run xattr -rc . on bindist tarball Fixes #21506. - - - - - cdc75a1f by Ben Gamari at 2022-06-15T20:33:04-04:00 configure: Hide spurious warning from ld Previously the check_for_gold_t22266 configure check could result in spurious warnings coming from the linker being blurted to stderr. Suppress these by piping stderr to /dev/null. - - - - - e128b7b8 by Ben Gamari at 2022-06-15T20:33:40-04:00 cmm: Add surface syntax for MO_MulMayOflo - - - - - bde65ea9 by Ben Gamari at 2022-06-15T20:34:16-04:00 configure: Don't attempt to override linker on Darwin Configure's --enable-ld-override functionality is intended to ensure that we don't rely on ld.bfd, which tends to be slow and buggy, on Linux and Windows. However, on Darwin the lack of sensible package management makes it extremely easy for users to have awkward mixtures of toolchain components from, e.g., XCode, the Apple Command-Line Tools package, and homebrew. This leads to extremely confusing problems like #21712. Here we avoid this by simply giving up on linker selection on Darwin altogether. This isn't so bad since the Apple ld64 linker has decent performance and AFAICT fairly reliable. Closes #21712. - - - - - 25b510c3 by Torsten Schmits at 2022-06-16T12:37:45-04:00 replace quadratic nub to fight byte code gen perf explosion Despite this code having been present in the core-to-bytecode implementation, I have observed it in the wild starting with 9.2, causing enormous slowdown in certain situations. My test case produces the following profiles: Before: ``` total time = 559.77 secs (559766 ticks @ 1000 us, 1 processor) total alloc = 513,985,665,640 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc ticks bytes elem_by Data.OldList libraries/base/Data/OldList.hs:429:1-7 67.6 92.9 378282 477447404296 eqInt GHC.Classes libraries/ghc-prim/GHC/Classes.hs:275:8-14 12.4 0.0 69333 32 $c>>= GHC.Data.IOEnv <no location info> 6.9 0.6 38475 3020371232 ``` After: ``` total time = 89.83 secs (89833 ticks @ 1000 us, 1 processor) total alloc = 39,365,306,360 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc ticks bytes $c>>= GHC.Data.IOEnv <no location info> 43.6 7.7 39156 3020403424 doCase GHC.StgToByteCode compiler/GHC/StgToByteCode.hs:(805,1)-(1054,53) 2.5 7.4 2246 2920777088 ``` - - - - - aa7e1f20 by Matthew Pickering at 2022-06-16T12:38:21-04:00 hadrian: Don't install `include/` directory in bindist. The install_includes for the RTS package used to be put in the top-level ./include folder but this would lead to confusing things happening if you installed multiple GHC versions side-by-side. We don't need this folder anymore because install-includes is honoured properly by cabal and the relevant header files already copied in by the cabal installation process. If you want to depend on the header files for the RTS in a Haskell project then you just have to depend on the `rts` package and the correct include directories will be provided for you. If you want to depend on the header files in a standard C project then you should query ghc-pkg to get the right paths. ``` ghc-pkg field rts include-dirs --simple-output ``` Fixes #21609 - - - - - 03172116 by Bryan Richter at 2022-06-16T12:38:57-04:00 Enable eventlogs on nightly perf job - - - - - ecbf8685 by Hécate Moonlight at 2022-06-16T16:30:00-04:00 Repair dead link in TH haddocks Closes #21724 - - - - - 99ff3818 by sheaf at 2022-06-16T16:30:39-04:00 Hadrian: allow configuring Hsc2Hs This patch adds the ability to pass options to Hsc2Hs as Hadrian key/value settings, in the same way as cabal configure options, using the syntax: *.*.hsc2hs.run.opts += ... - - - - - 9c575f24 by sheaf at 2022-06-16T16:30:39-04:00 Hadrian bootstrap: look up hsc2hs Hadrian bootstrapping looks up where to find ghc_pkg, but the same logic was not in place for hsc2hs which meant we could fail to find the appropriate hsc2hs executabe when bootstrapping Hadrian. This patch adds that missing logic. - - - - - 229d741f by Ben Gamari at 2022-06-18T10:42:54-04:00 ghc-heap: Add (broken) test for #21622 - - - - - cadd7753 by Ben Gamari at 2022-06-18T10:42:54-04:00 ghc-heap: Don't Box NULL pointers Previously we could construct a `Box` of a NULL pointer from the `link` field of `StgWeak`. Now we take care to avoid ever introducing such pointers in `collect_pointers` and ensure that the `link` field is represented as a `Maybe` in the `Closure` type. Fixes #21622 - - - - - 31c214cc by Tamar Christina at 2022-06-18T10:43:34-04:00 winio: Add support to console handles to handleToHANDLE - - - - - 711cb417 by Ben Gamari at 2022-06-18T10:44:11-04:00 CmmToAsm/AArch64: Add SMUL[LH] instructions These will be needed to fix #21624. - - - - - d05d90d2 by Ben Gamari at 2022-06-18T10:44:11-04:00 CmmToAsm/AArch64: Fix syntax of OpRegShift operands Previously this produced invalid assembly containing a redundant comma. - - - - - a1e1d8ee by Ben Gamari at 2022-06-18T10:44:11-04:00 ncg/aarch64: Fix implementation of IntMulMayOflo The code generated for IntMulMayOflo was previously wrong as it depended upon the overflow flag, which the AArch64 MUL instruction does not set. Fix this. Fixes #21624. - - - - - 26745006 by Ben Gamari at 2022-06-18T10:44:11-04:00 testsuite: Add test for #21624 Ensuring that mulIntMayOflo# behaves as expected. - - - - - 94f2e92a by Sebastian Graf at 2022-06-20T09:40:58+02:00 CprAnal: Set signatures of DFuns to top The recursive DFun in the reproducer for #20836 also triggered a bug in CprAnal that is observable in a debug build. The CPR signature of a recursive DFunId was never updated and hence the optimistic arity 0 bottom signature triggered a mismatch with the arity 1 of the binding in WorkWrap. We never miscompiled any code because WW doesn't exploit bottom CPR signatures. - - - - - b570da84 by Sebastian Graf at 2022-06-20T09:43:29+02:00 CorePrep: Don't speculatively evaluate recursive calls (#20836) In #20836 we have optimised a terminating program into an endless loop, because we speculated the self-recursive call of a recursive DFun. Now we track the set of enclosing recursive binders in CorePrep to prevent speculation of such self-recursive calls. See the updates to Note [Speculative evaluation] for details. Fixes #20836. - - - - - 49fb2f9b by Sebastian Graf at 2022-06-20T09:43:32+02:00 Simplify: Take care with eta reduction in recursive RHSs (#21652) Similar to the fix to #20836 in CorePrep, we now track the set of enclosing recursive binders in the SimplEnv and SimpleOptEnv. See Note [Eta reduction in recursive RHSs] for details. I also updated Note [Arity robustness] with the insights Simon and I had in a call discussing the issue. Fixes #21652. Unfortunately, we get a 5% ghc/alloc regression in T16577. That is due to additional eta reduction in GHC.Read.choose1 and the resulting ANF-isation of a large list literal at the top-level that didn't happen before (presumably because it was too interesting to float to the top-level). There's not much we can do about that. Metric Increase: T16577 - - - - - 2563b95c by Sebastian Graf at 2022-06-20T09:45:09+02:00 Ignore .hie-bios - - - - - e4e44d8d by Simon Peyton Jones at 2022-06-20T12:31:45-04:00 Instantiate top level foralls in partial type signatures The main fix for #21667 is the new call to tcInstTypeBnders in tcHsPartialSigType. It was really a simple omission before. I also moved the decision about whether we need to apply the Monomorphism Restriction, from `decideGeneralisationPlan` to `tcPolyInfer`. That removes a flag from the InferGen constructor, which is good. But more importantly, it allows the new function, checkMonomorphismRestriction called from `tcPolyInfer`, to "see" the `Types` involved rather than the `HsTypes`. And that in turn matters because we invoke the MR for partial signatures if none of the partial signatures in the group have any overloading context; and we can't answer that question for HsTypes. See Note [Partial type signatures and the monomorphism restriction] in GHC.Tc.Gen.Bind. This latter is really a pre-existing bug. - - - - - 262a9f93 by Winston Hartnett at 2022-06-20T12:32:23-04:00 Make Outputable instance for InlineSig print the InlineSpec Fix ghc/ghc#21739 Squash fix ghc/ghc#21739 - - - - - b5590fff by Matthew Pickering at 2022-06-20T12:32:59-04:00 Add NO_BOOT to hackage_doc_tarball job We were attempting to boot a src-tarball which doesn't work as ./boot is not included in the source tarball. This slipped through as the job is only run on nightly. - - - - - d24afd9d by Vladislav Zavialov at 2022-06-20T17:34:44-04:00 HsToken for @-patterns and TypeApplications (#19623) One more step towards the new design of EPA. - - - - - 159b7628 by Tamar Christina at 2022-06-20T17:35:23-04:00 linker: only keep rtl exception tables if they have been relocated - - - - - da5ff105 by Andreas Klebinger at 2022-06-21T17:04:12+02:00 Ticky:Make json info a separate field. - - - - - 1a4ce4b2 by Matthew Pickering at 2022-06-22T09:49:22+01:00 Revert "Ticky:Make json info a separate field." This reverts commit da5ff10503e683e2148c62e36f8fe2f819328862. This was pushed directly without review. - - - - - f89bf85f by Vanessa McHale at 2022-06-22T08:21:32-04:00 Flags to disable local let-floating; -flocal-float-out, -flocal-float-out-top-level CLI flags These flags affect the behaviour of local let floating. If `-flocal-float-out` is disabled (the default) then we disable all local floating. ``` …(let x = let y = e in (a,b) in body)... ===> …(let y = e; x = (a,b) in body)... ``` Further to this, top-level local floating can be disabled on it's own by passing -fno-local-float-out-top-level. ``` x = let y = e in (a,b) ===> y = e; x = (a,b) ``` Note that this is only about local floating, ie, floating two adjacent lets past each other and doesn't say anything about the global floating pass which is controlled by `-fno-float`. Fixes #13663 - - - - - 4ccefc6e by Matthew Craven at 2022-06-22T08:22:12-04:00 Check for Int overflows in Data.Array.Byte - - - - - 2004e3c8 by Matthew Craven at 2022-06-22T08:22:12-04:00 Add a basic test for ByteArray's Monoid instance - - - - - fb36770c by Matthew Craven at 2022-06-22T08:22:12-04:00 Rename `copyByteArray` to `unsafeCopyByteArray` - - - - - ecc9aedc by Ben Gamari at 2022-06-22T08:22:48-04:00 testsuite: Add test for #21719 Happily, this has been fixed since 9.2. - - - - - 19606c42 by Brandon Chinn at 2022-06-22T08:23:28-04:00 Use lookupNameCache instead of lookupOrigIO - - - - - 4c9dfd69 by Brandon Chinn at 2022-06-22T08:23:28-04:00 Break out thNameToGhcNameIO (ref. #21730) - - - - - eb4fb849 by Michael Peyton Jones at 2022-06-22T08:24:07-04:00 Add laws for 'toInteger' and 'toRational' CLC discussion here: https://github.com/haskell/core-libraries-committee/issues/58 - - - - - c1a950c1 by Alexander Esgen at 2022-06-22T12:36:13+00:00 Correct documentation of defaults of the `-V` RTS option - - - - - b7b7d90d by Matthew Pickering at 2022-06-22T21:58:12-04:00 Transcribe discussion from #21483 into a Note In #21483 I had a discussion with Simon Marlow about the memory retention behaviour of -Fd. I have just transcribed that conversation here as it elucidates the potentially subtle assumptions which led to the design of the memory retention behaviours of -Fd. Fixes #21483 - - - - - 980d1954 by Ben Gamari at 2022-06-22T21:58:48-04:00 eventlog: Don't leave dangling pointers hanging around Previously we failed to reset pointers to various eventlog buffers to NULL after freeing them. In principle we shouldn't look at them after they are freed but nevertheless it is good practice to set them to a well-defined value. - - - - - 575ec846 by Eric Lindblad at 2022-06-22T21:59:28-04:00 runhaskell - - - - - e6a69337 by Artem Pelenitsyn at 2022-06-22T22:00:07-04:00 re-export GHC.Natural.minusNaturalMaybe from Numeric.Natural CLC proposal: https://github.com/haskell/core-libraries-committee/issues/45 - - - - - 5d45aa97 by Gergo ERDI at 2022-06-22T22:00:46-04:00 When specialising, look through floatable ticks. Fixes #21697. - - - - - 531205ac by Andreas Klebinger at 2022-06-22T22:01:22-04:00 TagCheck.hs: Properly check if arguments are boxed types. For one by mistake I had been checking against the kind of runtime rep instead of the boxity. This uncovered another bug, namely that we tried to generate the checking code before we had associated the function arguments with a register, so this could never have worked to begin with. This fixes #21729 and both of the above issues. - - - - - c7f9f6b5 by Gleb Popov at 2022-06-22T22:02:00-04:00 Use correct arch for the FreeBSD triple in gen-data-layout.sh Downstream bug for reference: https://bugs.freebsd.org/bugzilla/show_bug.cgi?id=261798 Relevant upstream issue: #15718 - - - - - 75f0091b by Andreas Klebinger at 2022-06-22T22:02:35-04:00 Bump nofib submodule. Allows the shake runner to build with 9.2.3 among other things. Fixes #21772 - - - - - 0aa0ce69 by Ben Gamari at 2022-06-27T08:01:03-04:00 Bump ghc-prim and base versions To 0.9.0 and 4.17.0 respectively. Bumps array, deepseq, directory, filepath, haskeline, hpc, parsec, stm, terminfo, text, unix, haddock, and hsc2hs submodules. (cherry picked from commit ba47b95122b7b336ce1cc00896a47b584ad24095) - - - - - 4713abc2 by Ben Gamari at 2022-06-27T08:01:03-04:00 testsuite: Use normalise_version more consistently Previously several tests' output were unnecessarily dependent on version numbers, particularly of `base`. Fix this. - - - - - d7b0642b by Matthew Pickering at 2022-06-27T08:01:03-04:00 linters: Fix lint-submodule-refs when crashing trying to find plausible branches - - - - - 38378be3 by Andreas Klebinger at 2022-06-27T08:01:39-04:00 hadrian: Improve haddocks for ghcDebugAssertions - - - - - ac7a7fc8 by Andreas Klebinger at 2022-06-27T08:01:39-04:00 Don't mark lambda binders as OtherCon We used to put OtherCon unfoldings on lambda binders of workers and sometimes also join points/specializations with with the assumption that since the wrapper would force these arguments once we execute the RHS they would indeed be in WHNF. This was wrong for reasons detailed in #21472. So now we purge evaluated unfoldings from *all* lambda binders. This fixes #21472, but at the cost of sometimes not using as efficient a calling convention. It can also change inlining behaviour as some occurances will no longer look like value arguments when they did before. As consequence we also change how we compute CBV information for arguments slightly. We now *always* determine the CBV convention for arguments during tidy. Earlier in the pipeline we merely mark functions as candidates for having their arguments treated as CBV. As before the process is described in the relevant notes: Note [CBV Function Ids] Note [Attaching CBV Marks to ids] Note [Never put `OtherCon` unfoldigns on lambda binders] ------------------------- Metric Decrease: T12425 T13035 T18223 T18223 T18923 MultiLayerModulesTH_OneShot Metric Increase: WWRec ------------------------- - - - - - 06cf6f4a by Tony Zorman at 2022-06-27T08:02:18-04:00 Add suggestions for unrecognised pragmas (#21589) In case of a misspelled pragma, offer possible corrections as to what the user could have meant. Fixes: https://gitlab.haskell.org/ghc/ghc/-/issues/21589 - - - - - 3fbab757 by Greg Steuck at 2022-06-27T08:02:56-04:00 Remove the traces of i386-*-openbsd, long live amd64 OpenBSD will not ship any ghc packages on i386 starting with 7.2 release. This means there will not be a bootstrap compiler easily available. The last available binaries are ghc-8.10.6 which is already not supported as bootstrap for HEAD. See here for more information: https://marc.info/?l=openbsd-ports&m=165060700222580&w=2 - - - - - 58530271 by Bodigrim at 2022-06-27T08:03:34-04:00 Add Foldable1 and Bifoldable1 type classes Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/9 Instances roughly follow https://hackage.haskell.org/package/semigroupoids-5.3.7/docs/Data-Semigroup-Foldable-Class.html#t:Foldable1 but the API of `Foldable1` was expanded in comparison to `semigroupoids`. Compatibility shim is available from https://github.com/phadej/foldable1 (to be released). Closes #13573. - - - - - a51f4ecc by Naomi Liu at 2022-06-27T08:04:13-04:00 add levity polymorphism to addrToAny# - - - - - f4edcdc4 by Naomi Liu at 2022-06-27T08:04:13-04:00 add tests for addrToAny# levity - - - - - 07016fc9 by Matthew Pickering at 2022-06-27T08:04:49-04:00 hadrian: Update main README page This README had some quite out-of-date content about the build system so I did a complete pass deleting old material. I also made the section about flavours more prominent and mentioned flavour transformers. - - - - - 79ae2d89 by Ben Gamari at 2022-06-27T08:05:24-04:00 testsuite: Hide output from test compilations with verbosity==2 Previously the output from test compilations used to determine whether, e.g., profiling libraries are available was shown with verbosity levels >= 2. However, the default level is 2, meaning that most users were often spammed with confusing errors. Fix this by bumping the verbosity threshold for this output to >=3. Fixes #21760. - - - - - 995ea44d by Ben Gamari at 2022-06-27T08:06:00-04:00 configure: Only probe for LD in FIND_LD Since 6be2c5a7e9187fc14d51e1ec32ca235143bb0d8b we would probe for LD rather early in `configure`. However, it turns out that this breaks `configure`'s `ld`-override logic, which assumes that `LD` was set by the user and aborts. Fixes #21778. - - - - - b43d140b by Sergei Trofimovich at 2022-06-27T08:06:39-04:00 `.hs-boot` make rules: add missing order-only dependency on target directory Noticed missing target directory dependency as a build failure in `make --shuffle` mode (added in https://savannah.gnu.org/bugs/index.php?62100): "cp" libraries/base/./GHC/Stack/CCS.hs-boot libraries/base/dist-install/build/GHC/Stack/CCS.hs-boot cp: cannot create regular file 'libraries/base/dist-install/build/GHC/Stack/CCS.hs-boot': No such file or directory libraries/haskeline/ghc.mk:4: libraries/haskeline/dist-install/build/.depend-v-p-dyn.haskell: No such file or directory make[1]: *** [libraries/base/ghc.mk:4: libraries/base/dist-install/build/GHC/Stack/CCS.hs-boot] Error 1 shuffle=1656129254 make: *** [Makefile:128: all] Error 2 shuffle=1656129254 Note that `cp` complains about inability to create target file. The change adds order-only dependency on a target directory (similar to the rest of rules in that file). The bug is lurking there since 2009 commit 34cc75e1a (`GHC new build system megapatch`.) where upfront directory creation was never added to `.hs-boot` files. - - - - - 57a5f88c by Ben Gamari at 2022-06-28T03:24:24-04:00 Mark AArch64/Darwin as requiring sign-extension Apple's AArch64 ABI requires that the caller sign-extend small integer arguments. Set platformCConvNeedsExtension to reflect this fact. Fixes #21773. - - - - - df762ae9 by Ben Gamari at 2022-06-28T03:24:24-04:00 -ddump-llvm shouldn't imply -fllvm Previously -ddump-llvm would change the backend used, which contrasts with all other dump flags. This is quite surprising and cost me quite a bit of time. Dump flags should not change compiler behavior. Fixes #21776. - - - - - 70f0c1f8 by Ben Gamari at 2022-06-28T03:24:24-04:00 CmmToAsm/AArch64: Re-format argument handling logic Previously there were very long, hard to parse lines. Fix this. - - - - - 696d64c3 by Ben Gamari at 2022-06-28T03:24:24-04:00 CmmToAsm/AArch64: Sign-extend narrow C arguments The AArch64/Darwin ABI requires that function arguments narrower than 32-bits must be sign-extended by the caller. We neglected to do this, resulting in #20735. Fixes #20735. - - - - - c006ac0d by Ben Gamari at 2022-06-28T03:24:24-04:00 testsuite: Add test for #20735 - - - - - 16b9100c by Ben Gamari at 2022-06-28T03:24:59-04:00 integer-gmp: Fix cabal file Evidently fields may not come after sections in a cabal file. - - - - - 03cc5d02 by Sergei Trofimovich at 2022-06-28T15:20:45-04:00 ghc.mk: fix 'make install' (`mk/system-cxx-std-lib-1.0.conf.install` does not exist) before the change `make install` was failing as: ``` "mv" "/<<NIX>>/ghc-9.3.20220406/lib/ghc-9.5.20220625/bin/ghc-stage2" "/<<NIX>>/ghc-9.3.20220406/lib/ghc-9.5.20220625/bin/ghc" make[1]: *** No rule to make target 'mk/system-cxx-std-lib-1.0.conf.install', needed by 'install_packages'. Stop. ``` I think it's a recent regression caused by 0ef249aa where `system-cxx-std-lib-1.0.conf` is created (somewhat manually), but not the .install varianlt of it. The fix is to consistently use `mk/system-cxx-std-lib-1.0.conf` everywhere. Closes: https://gitlab.haskell.org/ghc/ghc/-/issues/21784 - - - - - eecab8f9 by Simon Peyton Jones at 2022-06-28T15:21:21-04:00 Comments only, about join points This MR just adds some documentation about why casts destroy join points, following #21716. - - - - - 251471e7 by Matthew Pickering at 2022-06-28T19:02:41-04:00 Cleanup BuiltInSyntax vs UserSyntax There was some confusion about whether FUN/TYPE/One/Many should be BuiltInSyntax or UserSyntax. The answer is certainly UserSyntax as BuiltInSyntax is for things which are directly constructed by the parser rather than going through normal renaming channels. I fixed all the obviously wrong places I could find and added a test for the original bug which was caused by this (#21752) Fixes #21752 #20695 #18302 - - - - - 0e22f16c by Ben Gamari at 2022-06-28T19:03:16-04:00 template-haskell: Bump version to 2.19.0.0 Bumps text and exceptions submodules due to bounds. - - - - - bbe6f10e by Emily Bourke at 2022-06-29T08:23:13+00:00 Tiny tweak to `IOPort#` documentation The exclamation mark and bracket don’t seem to make sense here. I’ve looked through the history, and I don’t think they’re deliberate – possibly a copy-and-paste error. - - - - - 70e47489 by Dominik Peteler at 2022-06-29T19:26:31-04:00 Remove `CoreOccurAnal` constructor of the `CoreToDo` type It was dead code since the last occurence in an expression context got removed in 71916e1c018dded2e68d6769a2dbb8777da12664. - - - - - d0722170 by nineonine at 2022-07-01T08:15:56-04:00 Fix panic with UnliftedFFITypes+CApiFFI (#14624) When declaring foreign import using CAPI calling convention, using unlifted unboxed types would result in compiler panic. There was an attempt to fix the situation in #9274, however it only addressed some of the ByteArray cases. This patch fixes other missed cases for all prims that may be used as basic foreign types. - - - - - eb043148 by Douglas Wilson at 2022-07-01T08:16:32-04:00 rts: gc stats: account properly for copied bytes in sequential collections We were not updating the [copied,any_work,scav_find_work, max_n_todo_overflow] counters during sequential collections. As well, we were double counting for parallel collections. To fix this we add an `else` clause to the `if (is_par_gc())`. The par_* counters do not need to be updated in the sequential case because they must be 0. - - - - - f95edea9 by Matthew Pickering at 2022-07-01T19:21:55-04:00 desugar: Look through ticks when warning about possible literal overflow Enabling `-fhpc` or `-finfo-table-map` would case a tick to end up between the appliation of `neg` to its argument. This defeated the special logic which looks for `NegApp ... (HsOverLit` to warn about possible overflow if a user writes a negative literal (without out NegativeLiterals) in their code. Fixes #21701 - - - - - f25c8d03 by Matthew Pickering at 2022-07-01T19:22:31-04:00 ci: Fix definition of slow-validate flavour (so that -dlint) is passed In this embarassing sequence of events we were running slow-validate without -dlint. - - - - - bf7991b0 by Mike Pilgrem at 2022-07-02T10:12:04-04:00 Identify the extistence of the `runhaskell` command and that it is equivalent to the `runghc` command. Add an entry to the index for `runhaskell`. See https://gitlab.haskell.org/ghc/ghc/-/issues/21411 - - - - - 9e79f6d0 by Simon Jakobi at 2022-07-02T10:12:39-04:00 Data.Foldable1: Remove references to Foldable-specific note ...as discussed in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/8495#note_439455. - - - - - 3a8970ac by romes at 2022-07-03T14:11:31-04:00 TTG: Move HsModule to L.H.S Move the definition of HsModule defined in GHC.Hs to Language.Haskell.Syntax with an added TTG parameter and corresponding extension fields. This is progress towards having the haskell-syntax package, as described in #21592 - - - - - f9f80995 by romes at 2022-07-03T14:11:31-04:00 TTG: Move ImpExp client-independent bits to L.H.S.ImpExp Move the GHC-independent definitions from GHC.Hs.ImpExp to Language.Haskell.Syntax.ImpExp with the required TTG extension fields such as to keep the AST independent from GHC. This is progress towards having the haskell-syntax package, as described in #21592 Bumps haddock submodule - - - - - c43dbac0 by romes at 2022-07-03T14:11:31-04:00 Refactor ModuleName to L.H.S.Module.Name ModuleName used to live in GHC.Unit.Module.Name. In this commit, the definition of ModuleName and its associated functions are moved to Language.Haskell.Syntax.Module.Name according to the current plan towards making the AST GHC-independent. The instances for ModuleName for Outputable, Uniquable and Binary were moved to the module in which the class is defined because these instances depend on GHC. The instance of Eq for ModuleName is slightly changed to no longer depend on unique explicitly and instead uses FastString's instance of Eq. - - - - - 2635c6f2 by konsumlamm at 2022-07-03T14:12:11-04:00 Expand `Ord` instance for `Down` Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/23#issuecomment-1172932610 - - - - - 36fba0df by Anselm Schüler at 2022-07-04T05:06:42+00:00 Add applyWhen to Data.Function per CLC prop Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/71#issuecomment-1165830233 - - - - - 3b13aab1 by Matthew Pickering at 2022-07-04T15:15:00-04:00 hadrian: Don't read package environments in ghc-stage1 wrapper The stage1 compiler may be on the brink of existence and not have even a working base library. You may have installed packages globally with a similar stage2 compiler which will then lead to arguments such as --show-iface not even working because you are passing too many package flags. The solution is simple, don't read these implicit files. Fixes #21803 - - - - - aba482ea by Andreas Klebinger at 2022-07-04T17:55:55-04:00 Ticky:Make json info a separate field. Fixes #21233 - - - - - 74f3867d by Matthew Pickering at 2022-07-04T17:56:30-04:00 Add docs:<pkg> command to hadrian to build docs for just one package - - - - - 418afaf1 by Matthew Pickering at 2022-07-04T17:56:30-04:00 upload-docs: propagate publish correctly in upload_sdist - - - - - ed793d7a by Matthew Pickering at 2022-07-04T17:56:30-04:00 docs-upload: Fix upload script when no packages are listed - - - - - d002c6e0 by Matthew Pickering at 2022-07-04T17:56:30-04:00 hadrian: Add --haddock-base-url option for specifying base-url when generating docs The motiviation for this flag is to be able to produce documentation which is suitable for uploading for hackage, ie, the cross-package links work correctly. There are basically three values you want to set this to: * off - default, base_url = ../%pkg% which works for local browsing * on - no argument , base_url = https:://hackage.haskell.org/package/%pkg%/docs - for hackage docs upload * on - argument, for example, base_url = http://localhost:8080/package/%pkg%/docs for testing the documentation. The `%pkg%` string is a template variable which is replaced with the package identifier for the relevant package. This is one step towards fixing #21749 - - - - - 41eb749a by Matthew Pickering at 2022-07-04T17:56:31-04:00 Add nightly job for generating docs suitable for hackage upload - - - - - 620ee7ed by Matthew Pickering at 2022-07-04T17:57:05-04:00 ghci: Support :set prompt in multi repl This adds supports for various :set commands apart from `:set <FLAG>` in multi repl, this includes `:set prompt` and so-on. Fixes #21796 - - - - - b151b65e by Matthew Pickering at 2022-07-05T16:32:31-04:00 Vendor filepath inside template-haskell Adding filepath as a dependency of template-haskell means that it can't be reinstalled if any build-plan depends on template-haskell. This is a temporary solution for the 9.4 release. A longer term solution is to split-up the template-haskell package into the wired-in part and a non-wired-in part which can be reinstalled. This was deemed quite risky on the 9.4 release timescale. Fixes #21738 - - - - - c9347ecf by John Ericson at 2022-07-05T16:33:07-04:00 Factor fields of `CoreDoSimplify` into separate data type This avoids some partiality. The work @mmhat is doing cleaning up and modularizing `Core.Opt` will build on this nicely. - - - - - d0e74992 by Eric Lindblad at 2022-07-06T01:35:48-04:00 https urls - - - - - 803e965c by Eric Lindblad at 2022-07-06T01:35:48-04:00 options and typos - - - - - 5519baa5 by Eric Lindblad at 2022-07-06T01:35:48-04:00 grammar - - - - - 4ddc1d3e by Eric Lindblad at 2022-07-06T01:35:48-04:00 sources - - - - - c95c2026 by Matthew Pickering at 2022-07-06T01:35:48-04:00 Fix lint warnings in bootstrap.py - - - - - 86ced2ad by romes at 2022-07-06T01:36:23-04:00 Restore Eq instance of ImportDeclQualifiedStyle Fixes #21819 - - - - - 3547e264 by romes at 2022-07-06T13:50:27-04:00 Prune L.H.S modules of GHC dependencies Move around datatypes, functions and instances that are GHC-specific out of the `Language.Haskell.Syntax.*` modules to reduce the GHC dependencies in them -- progressing towards #21592 Creates a module `Language.Haskell.Syntax.Basic` to hold basic definitions required by the other L.H.S modules (and don't belong in any of them) - - - - - e4eea07b by romes at 2022-07-06T13:50:27-04:00 TTG: Move CoreTickish out of LHS.Binds Remove the `[CoreTickish]` fields from datatype `HsBindLR idL idR` and move them to the extension point instance, according to the plan outlined in #21592 to separate the base AST from the GHC specific bits. - - - - - acc1816b by romes at 2022-07-06T13:50:27-04:00 TTG for ForeignImport/Export Add a TTG parameter to both `ForeignImport` and `ForeignExport` and, according to #21592, move the GHC-specific bits in them and in the other AST data types related to foreign imports and exports to the TTG extension point. - - - - - 371c5ecf by romes at 2022-07-06T13:50:27-04:00 TTG for HsTyLit Add TTG parameter to `HsTyLit` to move the GHC-specific `SourceText` fields to the extension point and out of the base AST. Progress towards #21592 - - - - - fd379d1b by romes at 2022-07-06T13:50:27-04:00 Remove many GHC dependencies from L.H.S Continue to prune the `Language.Haskell.Syntax.*` modules out of GHC imports according to the plan in the linked issue. Moves more GHC-specific declarations to `GHC.*` and brings more required GHC-independent declarations to `Language.Haskell.Syntax.*` (extending e.g. `Language.Haskell.Syntax.Basic`). Progress towards #21592 Bump haddock submodule for !8308 ------------------------- Metric Decrease: hard_hole_fits ------------------------- - - - - - c5415bc5 by Alan Zimmerman at 2022-07-06T13:50:27-04:00 Fix exact printing of the HsRule name Prior to this branch, the HsRule name was XRec pass (SourceText,RuleName) and there is an ExactPrint instance for (SourceText, RuleName). The SourceText has moved to a different location, so synthesise the original to trigger the correct instance when printing. We need both the SourceText and RuleName when exact printing, as it is possible to have a NoSourceText variant, in which case we fall back to the FastString. - - - - - 665fa5a7 by Matthew Pickering at 2022-07-06T13:51:03-04:00 driver: Fix issue with module loops and multiple home units We were attempting to rehydrate all dependencies of a particular module, but we actually only needed to rehydrate those of the current package (as those are the ones participating in the loop). This fixes loading GHC into a multi-unit session. Fixes #21814 - - - - - bbcaba6a by Andreas Klebinger at 2022-07-06T13:51:39-04:00 Remove a bogus #define from ClosureMacros.h - - - - - fa59223b by Tamar Christina at 2022-07-07T23:23:57-04:00 winio: make consoleReadNonBlocking not wait for any events at all. - - - - - 42c917df by Adam Sandberg Ericsson at 2022-07-07T23:24:34-04:00 rts: allow NULL to be used as an invalid StgStablePtr - - - - - 3739e565 by Andreas Schwab at 2022-07-07T23:25:10-04:00 RTS: Add stack marker to StgCRunAsm.S Every object file must be properly marked for non-executable stack, even if it contains no code. - - - - - a889bc05 by Ben Gamari at 2022-07-07T23:25:45-04:00 Bump unix submodule Adds `config.sub` to unix's `.gitignore`, fixing #19574. - - - - - 3609a478 by Matthew Pickering at 2022-07-09T11:11:58-04:00 ghci: Fix most calls to isLoaded to work in multi-mode The most egrarious thing this fixes is the report about the total number of loaded modules after starting a session. Ticket #20889 - - - - - fc183c90 by Matthew Pickering at 2022-07-09T11:11:58-04:00 Enable :edit command in ghci multi-mode. This works after the last change to isLoaded. Ticket #20888 - - - - - 46050534 by Simon Peyton Jones at 2022-07-09T11:12:34-04:00 Fix a scoping bug in the Specialiser In the call to `specLookupRule` in `already_covered`, in `specCalls`, we need an in-scope set that includes the free vars of the arguments. But we simply were not guaranteeing that: did not include the `rule_bndrs`. Easily fixed. I'm not sure how how this bug has lain for quite so long without biting us. Fixes #21828. - - - - - 6e8d9056 by Simon Peyton Jones at 2022-07-12T13:26:52+00:00 Edit Note [idArity varies independently of dmdTypeDepth] ...and refer to it in GHC.Core.Lint.lintLetBind. Fixes #21452 - - - - - 89ba4655 by Simon Peyton Jones at 2022-07-12T13:26:52+00:00 Tiny documentation wibbles (comments only) - - - - - 61a46c6d by Eric Lindblad at 2022-07-13T08:28:29-04:00 fix readme - - - - - 61babb5e by Eric Lindblad at 2022-07-13T08:28:29-04:00 fix bootstrap - - - - - 8b417ad5 by Eric Lindblad at 2022-07-13T08:28:29-04:00 tarball - - - - - e9d9f078 by Zubin Duggal at 2022-07-13T14:00:18-04:00 hie-files: Fix scopes for deriving clauses and instance signatures (#18425) - - - - - c4989131 by Zubin Duggal at 2022-07-13T14:00:18-04:00 hie-files: Record location of filled in default method bindings This is useful for hie files to reconstruct the evidence that default methods depend on. - - - - - 9c52e7fc by Zubin Duggal at 2022-07-13T14:00:18-04:00 testsuite: Factor out common parts from hiefile tests - - - - - 6a9e4493 by sheaf at 2022-07-13T14:00:56-04:00 Hadrian: update documentation of settings The documentation for key-value settings was a bit out of date. This patch updates it to account for `cabal.configure.opts` and `hsc2hs.run.opts`. The user-settings document was also re-arranged, to make the key-value settings more prominent (as it doesn't involve changing the Hadrian source code, and thus doesn't require any recompilation of Hadrian). - - - - - a2f142f8 by Zubin Duggal at 2022-07-13T20:43:32-04:00 Fix potential space leak that arise from ModuleGraphs retaining references to previous ModuleGraphs, in particular the lazy `mg_non_boot` field. This manifests in `extendMG`. Solution: Delete `mg_non_boot` as it is only used for `mgLookupModule`, which is only called in two places in the compiler, and should only be called at most once for every home unit: GHC.Driver.Make: mainModuleSrcPath :: Maybe String mainModuleSrcPath = do ms <- mgLookupModule mod_graph (mainModIs hue) ml_hs_file (ms_location ms) GHCI.UI: listModuleLine modl line = do graph <- GHC.getModuleGraph let this = GHC.mgLookupModule graph modl Instead `mgLookupModule` can be a linear function that looks through the entire list of `ModuleGraphNodes` Fixes #21816 - - - - - dcf8b30a by Ben Gamari at 2022-07-13T20:44:08-04:00 rts: Fix AdjustorPool bitmap manipulation Previously the implementation of bitmap_first_unset assumed that `__builtin_clz` would accept `uint8_t` however it apparently rather extends its argument to `unsigned int`. To fix this we simply revert to a naive implementation since handling the various corner cases with `clz` is quite tricky. This should be fine given that AdjustorPool isn't particularly hot. Ideally we would have a single, optimised bitmap implementation in the RTS but I'll leave this for future work. Fixes #21838. - - - - - ad8f3e15 by Luite Stegeman at 2022-07-16T07:20:36-04:00 Change GHCi bytecode return convention for unlifted datatypes. This changes the bytecode return convention for unlifted algebraic datatypes to be the same as for lifted types, i.e. ENTER/PUSH_ALTS instead of RETURN_UNLIFTED/PUSH_ALTS_UNLIFTED Fixes #20849 - - - - - 5434d1a3 by Colten Webb at 2022-07-16T07:21:15-04:00 Compute record-dot-syntax types Ensures type information for record-dot-syntax is included in HieASTs. See #21797 - - - - - 89d169ec by Colten Webb at 2022-07-16T07:21:15-04:00 Add record-dot-syntax test - - - - - 4beb9f3c by Ben Gamari at 2022-07-16T07:21:51-04:00 Document RuntimeRep polymorphism limitations of catch#, et al As noted in #21868, several primops accepting continuations producing RuntimeRep-polymorphic results aren't nearly as polymorphic as their types suggest. Document this limitation and adapt the `UnliftedWeakPtr` test to avoid breaking this limitation in `keepAlive#`. - - - - - 4ef1c65d by Ben Gamari at 2022-07-16T07:21:51-04:00 Make keepAlive# out-of-line This is a naive approach to fixing the unsoundness noticed in #21708. Specifically, we remove the lowering of `keepAlive#` via CorePrep and instead turn it into an out-of-line primop. This is simple, inefficient (since the continuation must now be heap allocated), but good enough for 9.4.1. We will revisit this (particiularly via #16098) in a future release. Metric Increase: T4978 T7257 T9203 - - - - - 1bbff35d by Greg Steuck at 2022-07-16T07:22:29-04:00 Suppress extra output from configure check for c++ libraries - - - - - 3acbd7ad by Ben Gamari at 2022-07-16T07:23:04-04:00 rel-notes: Drop mention of #21745 fix Since we have backported the fix to 9.4.1. - - - - - b27c2774 by Dominik Peteler at 2022-07-16T07:23:43-04:00 Align the behaviour of `dopt` and `log_dopt` Before the behaviour of `dopt` and `logHasDumpFlag` (and the underlying function `log_dopt`) were different as the latter did not take the verbosity level into account. This led to problems during the refactoring as we cannot simply replace calls to `dopt` with calls to `logHasDumpFlag`. In addition to that a subtle bug in the GHC module was fixed: `setSessionDynFlags` did not update the logger and as a consequence the verbosity value of the logger was not set appropriately. Fixes #21861 - - - - - 28347d71 by Douglas Wilson at 2022-07-16T13:25:06-04:00 rts: forkOn context switches the target capability Fixes #21824 - - - - - f1c44991 by Ben Gamari at 2022-07-16T13:25:41-04:00 cmm: Eliminate orphan Outputable instances Here we reorganize `GHC.Cmm` to eliminate the orphan `Outputable` and `OutputableP` instances for the Cmm AST. This makes it significantly easier to use the Cmm pretty-printers in tracing output without incurring module import cycles. - - - - - f2e5e763 by Ben Gamari at 2022-07-16T13:25:41-04:00 cmm: Move toBlockList to GHC.Cmm - - - - - fa092745 by Ben Gamari at 2022-07-16T13:25:41-04:00 compiler: Add haddock sections to GHC.Utils.Panic - - - - - 097759f9 by Ben Gamari at 2022-07-16T13:26:17-04:00 configure: Don't override Windows CXXFLAGS At some point we used the clang distribution from msys2's `MINGW64` environment for our Windows toolchain. This defaulted to using libgcc and libstdc++ for its runtime library. However, we found for a variety of reasons that compiler-rt, libunwind, and libc++ were more reliable, consequently we explicitly overrode the CXXFLAGS to use these. However, since then we have switched to use the `CLANG64` packaging, which default to these already. Consequently we can drop these arguments, silencing some redundant argument warnings from clang. Fixes #21669. - - - - - e38a2684 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/Elf: Check that there are no NULL ctors - - - - - 616365b0 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/Elf: Introduce support for invoking finalizers on unload Addresses #20494. - - - - - cdd3be20 by Ben Gamari at 2022-07-16T23:50:36-04:00 testsuite: Add T20494 - - - - - 03c69d8d by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Rename finit field to fini fini is short for "finalizer", which does not contain a "t". - - - - - 033580bc by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Refactor handling of oc->info Previously we would free oc->info after running initializers. However, we can't do this is we want to also run finalizers. Moreover, freeing oc->info so early was wrong for another reason: we will need it in order to unregister the exception tables (see the call to `RtlDeleteFunctionTable`). In service of #20494. - - - - - f17912e4 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Add finalization support This implements #20494 for the PEi386 linker. Happily, this also appears to fix `T9405`, resolving #21361. - - - - - 2cd75550 by Ben Gamari at 2022-07-16T23:50:36-04:00 Loader: Implement gnu-style -l:$path syntax Gnu ld allows `-l` to be passed an absolute file path, signalled by a `:` prefix. Implement this in the GHC's loader search logic. - - - - - 5781a360 by Ben Gamari at 2022-07-16T23:50:36-04:00 Statically-link against libc++ on Windows Unfortunately on Windows we have no RPATH-like facility, making dynamic linking extremely fragile. Since we cannot assume that the user will add their GHC installation to `$PATH` (and therefore their DLL search path) we cannot assume that the loader will be able to locate our `libc++.dll`. To avoid this, we instead statically link against `libc++.a` on Windows. Fixes #21435. - - - - - 8e2e883b by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Ensure that all .ctors/.dtors sections are run It turns out that PE objects may have multiple `.ctors`/`.dtors` sections but the RTS linker had assumed that there was only one. Fix this. Fixes #21618. - - - - - fba04387 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Respect dtor/ctor priority Previously we would run constructors and destructors in arbitrary order despite explicit priorities. Fixes #21847. - - - - - 1001952f by Ben Gamari at 2022-07-16T23:50:36-04:00 testsuite: Add test for #21618 and #21847 - - - - - 6f3816af by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Fix exception unwind unregistration RtlDeleteFunctionTable expects a pointer to the .pdata section yet we passed it the .xdata section. Happily, this fixes #21354. - - - - - d9bff44c by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/MachO: Drop dead code - - - - - d161e6bc by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/MachO: Use section flags to identify initializers - - - - - fbb17110 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/MachO: Introduce finalizer support - - - - - 5b0ed8a8 by Ben Gamari at 2022-07-16T23:50:37-04:00 testsuite: Use system-cxx-std-lib instead of config.stdcxx_impl - - - - - 6c476e1a by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker/Elf: Work around GCC 6 init/fini behavior It appears that GCC 6t (at least on i386) fails to give init_array/fini_array sections the correct SHT_INIT_ARRAY/SHT_FINI_ARRAY section types, instead marking them as SHT_PROGBITS. This caused T20494 to fail on Debian. - - - - - 5f8203b8 by Ben Gamari at 2022-07-16T23:50:37-04:00 testsuite: Mark T13366Cxx as unbroken on Darwin - - - - - 1fd2f851 by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker: Fix resolution of __dso_handle on Darwin Darwin expects a leading underscore. - - - - - a2dc00f3 by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker: Clean up section kinds - - - - - aeb1a7c3 by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker: Ensure that __cxa_finalize is called on code unload - - - - - 028f081e by Ben Gamari at 2022-07-16T23:51:12-04:00 testsuite: Fix T11829 on Centos 7 It appears that Centos 7 has a more strict C++ compiler than most distributions since std::runtime_error is defined in <stdexcept> rather than <exception>. In T11829 we mistakenly imported the latter. - - - - - a10584e8 by Ben Gamari at 2022-07-17T22:30:32-04:00 hadrian: Rename documentation directories for consistency with make * Rename `docs` to `doc` * Place pdf documentation in `doc/` instead of `doc/pdfs/` Fixes #21164. - - - - - b27c5947 by Anselm Schüler at 2022-07-17T22:31:11-04:00 Fix incorrect proof of applyWhen’s properties - - - - - eb031a5b by Matthew Pickering at 2022-07-18T08:04:47-04:00 hadrian: Add multi:<pkg> and multi targets for starting a multi-repl This patch adds support to hadrian for starting a multi-repl containing all the packages which stage0 can build. In particular, there is the new user-facing command: ``` ./hadrian/ghci-multi ``` which when executed will start a multi-repl containing the `ghc` package and all it's dependencies. This is implemented by two new hadrian targets: ``` ./hadrian/build multi:<pkg> ``` Construct the arguments for a multi-repl session where the top-level package is <pkg>. For example, `./hadrian/ghci-multi` is implemented using `multi:ghc` target. There is also the `multi` command which constructs a repl for everything in stage0 which we can build. - - - - - 19e7cac9 by Eric Lindblad at 2022-07-18T08:05:27-04:00 changelog typo - - - - - af6731a4 by Eric Lindblad at 2022-07-18T08:05:27-04:00 typos - - - - - 415468fe by Simon Peyton Jones at 2022-07-18T16:36:54-04:00 Refactor SpecConstr to use treat bindings uniformly This patch, provoked by #21457, simplifies SpecConstr by treating top-level and nested bindings uniformly (see the new scBind). * Eliminates the mysterious scTopBindEnv * Refactors scBind to handle top-level and nested definitions uniformly. * But, for now at least, continues the status quo of not doing SpecConstr for top-level non-recursive bindings. (In contrast we do specialise nested non-recursive bindings, although the original paper did not; see Note [Local let bindings].) I tried the effect of specialising top-level non-recursive bindings (which is now dead easy to switch on, unlike before) but found some regressions, so I backed off. See !8135. It's a pure refactoring. I think it'll do a better job in a few cases, but there is no regression test. - - - - - d4d3fe6e by Andreas Klebinger at 2022-07-18T16:37:29-04:00 Rule matching: Don't compute the FVs if we don't look at them. - - - - - 5f907371 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 White space only in FamInstEnv - - - - - ae3b3b62 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Make transferPolyIdInfo work for CPR I don't know why this hasn't bitten us before, but it was plain wrong. - - - - - 9bdfdd98 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Inline mapAccumLM This function is called in inner loops in the compiler, and it's overloaded and higher order. Best just to inline it. This popped up when I was looking at something else. I think perhaps GHC is delicately balanced on the cusp of inlining this automatically. - - - - - d0b806ff by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Make SetLevels honour floatConsts This fix, in the definition of profitableFloat, is just for consistency. `floatConsts` should do what it says! I don't think it'll affect anything much, though. - - - - - d1c25a48 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Refactor wantToUnboxArg a bit * Rename GHC.Core.Opt.WorkWrap.Utils.wantToUnboxArg to canUnboxArg and similarly wantToUnboxResult to canUnboxResult. * Add GHC.Core.Opt.DmdAnal.wantToUnboxArg as a wrapper for the (new) GHC.Core.Opt.WorkWrap.Utils.canUnboxArg, avoiding some yukky duplication. I decided it was clearer to give it a new data type for its return type, because I nedeed the FD_RecBox case which was not otherwise readiliy expressible. * Add dcpc_args to WorkWrap.Utils.DataConPatContext for the payload * Get rid of the Unlift constructor of UnboxingDecision, eliminate two panics, and two arguments to canUnboxArg (new name). Much nicer now. - - - - - 6d8a715e by Teo Camarasu at 2022-07-18T16:38:44-04:00 Allow running memInventory when the concurrent nonmoving gc is enabled If the nonmoving gc is enabled and we are using a threaded RTS, we now try to grab the collector mutex to avoid memInventory and the collection racing. Before memInventory was disabled. - - - - - aa75bbde by Ben Gamari at 2022-07-18T16:39:20-04:00 gitignore: don't ignore all aclocal.m4 files While GHC's own aclocal.m4 is generated by the aclocal tool, other packages' aclocal.m4 are committed in the repository. Previously `.gitignore` included an entry which covered *any* file named `aclocal.m4`, which lead to quite some confusion (e.g. see #21740). Fix this by modifying GHC's `.gitignore` to only cover GHC's own `aclocal.m4`. - - - - - 4b98c5ce by Boris Lykah at 2022-07-19T02:34:12-04:00 Add mapAccumM, forAccumM to Data.Traversable Approved by Core Libraries Committee in https://github.com/haskell/core-libraries-committee/issues/65#issuecomment-1186275433 - - - - - bd92182c by Ben Gamari at 2022-07-19T02:34:47-04:00 configure: Use AC_PATH_TOOL to detect tools Previously we used AC_PATH_PROG which, as noted by #21601, does not look for tools with a target prefix, breaking cross-compilation. Fixes #21601. - - - - - e8c07aa9 by Matthew Pickering at 2022-07-19T10:07:53-04:00 driver: Fix implementation of -S We were failing to stop before running the assembler so the object file was also created. Fixes #21869 - - - - - e2f0094c by Ben Gamari at 2022-07-19T10:08:28-04:00 rts/ProfHeap: Ensure new Censuses are zeroed When growing the Census array ProfHeap previously neglected to zero the new part of the array. Consequently `freeEra` would attempt to free random words that often looked suspiciously like pointers. Fixes #21880. - - - - - 81d65f7f by sheaf at 2022-07-21T15:37:22+02:00 Make withDict opaque to the specialiser As pointed out in #21575, it is not sufficient to set withDict to inline after the typeclass specialiser, because we might inline withDict in one module and then import it in another, and we run into the same problem. This means we could still end up with incorrect runtime results because the typeclass specialiser would assume that distinct typeclass evidence terms at the same type are equal, when this is not necessarily the case when using withDict. Instead, this patch introduces a new magicId, 'nospec', which is only inlined in CorePrep. We make use of it in the definition of withDict to ensure that the typeclass specialiser does not common up distinct typeclass evidence terms. Fixes #21575 - - - - - 9a3e1f31 by Dominik Peteler at 2022-07-22T08:18:40-04:00 Refactored Simplify pass * Removed references to driver from GHC.Core.LateCC, GHC.Core.Simplify namespace and GHC.Core.Opt.Stats. Also removed services from configuration records. * Renamed GHC.Core.Opt.Simplify to GHC.Core.Opt.Simplify.Iteration. * Inlined `simplifyPgm` and renamed `simplifyPgmIO` to `simplifyPgm` and moved the Simplify driver to GHC.Core.Opt.Simplify. * Moved `SimplMode` and `FloatEnable` to GHC.Core.Opt.Simplify.Env. * Added a configuration record `TopEnvConfig` for the `SimplTopEnv` environment in GHC.Core.Opt.Simplify.Monad. * Added `SimplifyOpts` and `SimplifyExprOpts`. Provide initialization functions for those in a new module GHC.Driver.Config.Core.Opt.Simplify. Also added initialization functions for `SimplMode` to that module. * Moved `CoreToDo` and friends to a new module GHC.Core.Pipeline.Types and the counting types and functions (`SimplCount` and `Tick`) to new module GHC.Core.Opt.Stats. * Added getter functions for the fields of `SimplMode`. The pedantic bottoms option and the platform are retrieved from the ArityOpts and RuleOpts and the getter functions allow us to retrieve values from `SpecEnv` without the knowledge where the data is stored exactly. * Moved the coercion optimization options from the top environment to `SimplMode`. This way the values left in the top environment are those dealing with monadic functionality, namely logging, IO related stuff and counting. Added a note "The environments of the Simplify pass". * Removed `CoreToDo` from GHC.Core.Lint and GHC.CoreToStg.Prep and got rid of `CoreDoSimplify`. Pass `SimplifyOpts` in the `CoreToDo` type instead. * Prep work before removing `InteractiveContext` from `HscEnv`. - - - - - 2c5991cc by Simon Peyton Jones at 2022-07-22T08:18:41-04:00 Make the specialiser deal better with specialised methods This patch fixes #21848, by being more careful to update unfoldings in the type-class specialiser. See the new Note [Update unfolding after specialisation] Now that we are being so much more careful about unfoldings, it turned out that I could dispense with se_interesting, and all its tricky corners. Hooray. This fixes #21368. - - - - - ae166635 by Ben Gamari at 2022-07-22T08:18:41-04:00 ghc-boot: Clean up UTF-8 codecs In preparation for moving the UTF-8 codecs into `base`: * Move them to GHC.Utils.Encoding.UTF8 * Make names more consistent * Add some Haddocks - - - - - e8ac91db by Ben Gamari at 2022-07-22T08:18:41-04:00 base: Introduce GHC.Encoding.UTF8 Here we copy a subset of the UTF-8 implementation living in `ghc-boot` into `base`, with the intent of dropping the former in the future. For this reason, the `ghc-boot` copy is now CPP-guarded on `MIN_VERSION_base(4,18,0)`. Naturally, we can't copy *all* of the functions defined by `ghc-boot` as some depend upon `bytestring`; we rather just copy those which only depend upon `base` and `ghc-prim`. Further consolidation? ---------------------- Currently GHC ships with at least five UTF-8 implementations: * the implementation used by GHC in `ghc-boot:GHC.Utils.Encoding`; this can be used at a number of types including `Addr#`, `ByteArray#`, `ForeignPtr`, `Ptr`, `ShortByteString`, and `ByteString`. Most of this can be removed in GHC 9.6+2, when the copies in `base` will become available to `ghc-boot`. * the copy of the `ghc-boot` definition now exported by `base:GHC.Encoding.UTF8`. This can be used at `Addr#`, `Ptr`, `ByteArray#`, and `ForeignPtr` * the decoder used by `unpackCStringUtf8#` in `ghc-prim:GHC.CString`; this is specialised at `Addr#`. * the codec used by the IO subsystem in `base:GHC.IO.Encoding.UTF8`; this is specialised at `Addr#` but, unlike the above, supports recovery in the presence of partial codepoints (since in IO contexts codepoints may be broken across buffers) * the implementation provided by the `text` library This does seem a tad silly. On the other hand, these implementations *do* materially differ from one another (e.g. in the types they support, the detail in errors they can report, and the ability to recover from partial codepoints). Consequently, it's quite unclear that further consolidate would be worthwhile. - - - - - f9ad8025 by Ben Gamari at 2022-07-22T08:18:41-04:00 Add a Note summarising GHC's UTF-8 implementations GHC has a somewhat dizzying array of UTF-8 implementations. This note describes why this is the case. - - - - - 72dfad3d by Ben Gamari at 2022-07-22T08:18:42-04:00 upload_ghc_libs: Fix path to documentation The documentation was moved in a10584e8df9b346cecf700b23187044742ce0b35 but this one occurrence was note updated. Finally closes #21164. - - - - - a8b150e7 by sheaf at 2022-07-22T08:18:44-04:00 Add test for #21871 This adds a test for #21871, which was fixed by the No Skolem Info rework (MR !7105). Fixes #21871 - - - - - 6379f942 by sheaf at 2022-07-22T08:18:46-04:00 Add test for #21360 The way record updates are typechecked/desugared changed in MR !7981. Because we desugar in the typechecker to a simple case expression, the pattern match checker becomes able to spot the long-distance information and avoid emitting an incorrect pattern match warning. Fixes #21360 - - - - - ce0cd12c by sheaf at 2022-07-22T08:18:47-04:00 Hadrian: don't try to build "unix" on Windows - - - - - dc27e15a by Simon Peyton Jones at 2022-07-25T09:42:01-04:00 Implement DeepSubsumption This MR adds the language extension -XDeepSubsumption, implementing GHC proposal #511. This change mitigates the impact of GHC proposal The changes are highly localised, by design. See Note [Deep subsumption] in GHC.Tc.Utils.Unify. The main changes are: * Add -XDeepSubsumption, which is on by default in Haskell98 and Haskell2010, but off in Haskell2021. -XDeepSubsumption largely restores the behaviour before the "simple subsumption" change. -XDeepSubsumpition has a similar flavour as -XNoMonoLocalBinds: it makes type inference more complicated and less predictable, but it may be convenient in practice. * The main changes are in: * GHC.Tc.Utils.Unify.tcSubType, which does deep susumption and eta-expanansion * GHC.Tc.Utils.Unify.tcSkolemiseET, which does deep skolemisation * In GHC.Tc.Gen.App.tcApp we call tcSubTypeNC to match the result type. Without deep subsumption, unifyExpectedType would be sufficent. See Note [Deep subsumption] in GHC.Tc.Utils.Unify. * There are no changes to Quick Look at all. * The type of `withDict` becomes ambiguous; so add -XAllowAmbiguousTypes to GHC.Magic.Dict * I fixed a small but egregious bug in GHC.Core.FVs.varTypeTyCoFVs, where we'd forgotten to take the free vars of the multiplicity of an Id. * I also had to fix tcSplitNestedSigmaTys When I did the shallow-subsumption patch commit 2b792facab46f7cdd09d12e79499f4e0dcd4293f Date: Sun Feb 2 18:23:11 2020 +0000 Simple subsumption I changed tcSplitNestedSigmaTys to not look through function arrows any more. But that was actually an un-forced change. This function is used only in * Improving error messages in GHC.Tc.Gen.Head.addFunResCtxt * Validity checking for default methods: GHC.Tc.TyCl.checkValidClass * A couple of calls in the GHCi debugger: GHC.Runtime.Heap.Inspect All to do with validity checking and error messages. Acutally its fine to look under function arrows here, and quite useful a test DeepSubsumption05 (a test motivated by a build failure in the `lens` package) shows. The fix is easy. I added Note [tcSplitNestedSigmaTys]. - - - - - e31ead39 by Matthew Pickering at 2022-07-25T09:42:01-04:00 Add tests that -XHaskell98 and -XHaskell2010 enable DeepSubsumption - - - - - 67189985 by Matthew Pickering at 2022-07-25T09:42:01-04:00 Add DeepSubsumption08 - - - - - 5e93a952 by Simon Peyton Jones at 2022-07-25T09:42:01-04:00 Fix the interaction of operator sections and deep subsumption Fixes DeepSubsumption08 - - - - - 918620d9 by Zubin Duggal at 2022-07-25T09:42:01-04:00 Add DeepSubsumption09 - - - - - 2a773259 by Gabriella Gonzalez at 2022-07-25T09:42:40-04:00 Default implementation for mempty/(<>) Approved by: https://github.com/haskell/core-libraries-committee/issues/61 This adds a default implementation for `mempty` and `(<>)` along with a matching `MINIMAL` pragma so that `Semigroup` and `Monoid` instances can be defined in terms of `sconcat` / `mconcat`. The description for each class has also been updated to include the equivalent set of laws for the `sconcat`-only / `mconcat`-only instances. - - - - - 73836fc8 by Bryan Richter at 2022-07-25T09:43:16-04:00 ci: Disable (broken) perf-nofib See #21859 - - - - - c24ca5c3 by sheaf at 2022-07-25T09:43:58-04:00 Docs: clarify ConstraintKinds infelicity GHC doesn't consistently require the ConstraintKinds extension to be enabled, as it allows programs such as type families returning a constraint without this extension. MR !7784 fixes this infelicity, but breaking user programs was deemed to not be worth it, so we document it instead. Fixes #21061. - - - - - 5f2fbd5e by Simon Peyton Jones at 2022-07-25T09:44:34-04:00 More improvements to worker/wrapper This patch fixes #21888, and simplifies finaliseArgBoxities by eliminating the (recently introduced) data type FinalDecision. A delicate interaction meant that this patch commit d1c25a48154236861a413e058ea38d1b8320273f Date: Tue Jul 12 16:33:46 2022 +0100 Refactor wantToUnboxArg a bit make worker/wrapper go into an infinite loop. This patch fixes it by narrowing the handling of case (B) of Note [Boxity for bottoming functions], to deal only the arguemnts that are type variables. Only then do we drop the trimBoxity call, which is what caused the bug. I also * Added documentation of case (B), which was previously completely un-mentioned. And a regression test, T21888a, to test it. * Made unboxDeeplyDmd stop at lazy demands. It's rare anyway for a bottoming function to have a lazy argument (mainly when the data type is recursive and then we don't want to unbox deeply). Plus there is Note [No lazy, Unboxed demands in demand signature] * Refactored the Case equation for dmdAnal a bit, to do less redundant pattern matching. - - - - - b77d95f8 by Simon Peyton Jones at 2022-07-25T09:45:09-04:00 Fix a small buglet in tryEtaReduce Gergo points out (#21801) that GHC.Core.Opt.Arity.tryEtaReduce was making an ill-formed cast. It didn't matter, because the subsequent guard discarded it; but still worth fixing. Spurious warnings are distracting. - - - - - 3bbde957 by Zubin Duggal at 2022-07-25T09:45:45-04:00 Fix #21889, GHCi misbehaves with Ctrl-C on Windows On Windows, we create multiple levels of wrappers for GHCi which ultimately execute ghc --interactive. In order to handle console events properly, each of these wrappers must call FreeConsole() in order to hand off event processing to the child process. See #14150. In addition to this, FreeConsole must only be called from interactive processes (#13411). This commit makes two changes to fix this situation: 1. The hadrian wrappers generated using `hadrian/bindist/cwrappers/version-wrapper.c` call `FreeConsole` if the CPP flag INTERACTIVE_PROCESS is set, which is set when we are generating a wrapper for GHCi. 2. The GHCi wrapper in `driver/ghci/` calls the `ghc-$VER.exe` executable which is not wrapped rather than calling `ghc.exe` is is wrapped on windows (and usually non-interactive, so can't call `FreeConsole`: Before: ghci-$VER.exe calls ghci.exe which calls ghc.exe which calls ghc-$VER.exe After: ghci-$VER.exe calls ghci.exe which calls ghc-$VER.exe - - - - - 79f1b021 by Simon Jakobi at 2022-07-25T09:46:21-04:00 docs: Fix documentation of \cases Fixes #21902. - - - - - e4bf9592 by sternenseemann at 2022-07-25T09:47:01-04:00 ghc-cabal: allow Cabal 3.8 to unbreak make build When bootstrapping GHC 9.4.*, the build will fail when configuring ghc-cabal as part of the make based build system due to this upper bound, as Cabal has been updated to a 3.8 release. Reference #21914, see especially https://gitlab.haskell.org/ghc/ghc/-/issues/21914#note_444699 - - - - - 726d938e by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Fix isEvaldUnfolding and isValueUnfolding This fixes (1) in #21831. Easy, obviously correct. - - - - - 5d26c321 by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Switch off eta-expansion in rules and unfoldings I think this change will make little difference except to reduce clutter. But that's it -- if it causes problems we can switch it on again. - - - - - d4fe2f4e by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Teach SpecConstr about typeDeterminesValue This patch addresses #21831, point 2. See Note [generaliseDictPats] in SpecConstr I took the opportunity to refactor the construction of specialisation rules a bit, so that the rule name says what type we are specialising at. Surprisingly, there's a 20% decrease in compile time for test perf/compiler/T18223. I took a look at it, and the code size seems the same throughout. I did a quick ticky profile which seemed to show a bit less substitution going on. Hmm. Maybe it's the "don't do eta-expansion in stable unfoldings" patch, which is part of the same MR as this patch. Anyway, since it's a move in the right direction, I didn't think it was worth looking into further. Metric Decrease: T18223 - - - - - 65f7838a by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Add a 'notes' file in testsuite/tests/perf/compiler This file is just a place to accumlate notes about particular benchmarks, so that I don't keep re-inventing the wheel. - - - - - 61faff40 by Simon Peyton Jones at 2022-07-25T14:38:50-04:00 Get the in-scope set right in FamInstEnv.injectiveBranches There was an assert error, as Gergo pointed out in #21896. I fixed this by adding an InScopeSet argument to tcUnifyTyWithTFs. And also to GHC.Core.Unify.niFixTCvSubst. I also took the opportunity to get a couple more InScopeSets right, and to change some substTyUnchecked into substTy. This MR touches a lot of other files, but only because I also took the opportunity to introduce mkInScopeSetList, and use it. - - - - - 4a7256a7 by Cheng Shao at 2022-07-25T20:41:55+00:00 Add location to cc phase - - - - - 96811ba4 by Cheng Shao at 2022-07-25T20:41:55+00:00 Avoid as pipeline when compiling c - - - - - 2869b66d by Cheng Shao at 2022-07-25T20:42:20+00:00 testsuite: Skip test cases involving -S when testing unregisterised GHC We no longer generate .s files anyway. Metric Decrease: MultiLayerModules T10421 T13035 T13701 T14697 T16875 T18140 T18304 T18923 T9198 - - - - - 82a0991a by Ben Gamari at 2022-07-25T23:32:05-04:00 testsuite: introduce nonmoving_thread_sanity way (cherry picked from commit 19f8fce3659de3d72046bea9c61d1a82904bc4ae) - - - - - 4b087973 by Ben Gamari at 2022-07-25T23:32:06-04:00 rts/nonmoving: Track segment state It can often be useful during debugging to be able to determine the state of a nonmoving segment. Introduce some state, enabled by DEBUG, to track this. (cherry picked from commit 40e797ef591ae3122ccc98ab0cc3cfcf9d17bd7f) - - - - - 54a5c32d by Ben Gamari at 2022-07-25T23:32:06-04:00 rts/nonmoving: Don't scavenge objects which weren't evacuated This fixes a rather subtle bug in the logic responsible for scavenging objects evacuated to the non-moving generation. In particular, objects can be allocated into the non-moving generation by two ways: a. evacuation out of from-space by the garbage collector b. direct allocation by the mutator Like all evacuation, objects moved by (a) must be scavenged, since they may contain references to other objects located in from-space. To accomplish this we have the following scheme: * each nonmoving segment's block descriptor has a scan pointer which points to the first object which has yet to be scavenged * the GC tracks a set of "todo" segments which have pending scavenging work * to scavenge a segment, we scavenge each of the unmarked blocks between the scan pointer and segment's `next_free` pointer. We skip marked blocks since we know the allocator wouldn't have allocated into marked blocks (since they contain presumably live data). We can stop at `next_free` since, by definition, the GC could not have evacuated any objects to blocks above `next_free` (otherwise `next_free wouldn't be the first free block). However, this neglected to consider objects allocated by path (b). In short, the problem is that objects directly allocated by the mutator may become unreachable (but not swept, since the containing segment is not yet full), at which point they may contain references to swept objects. Specifically, we observed this in #21885 in the following way: 1. the mutator (specifically in #21885, a `lockCAF`) allocates an object (specifically a blackhole, which here we will call `blkh`; see Note [Static objects under the nonmoving collector] for the reason why) on the non-moving heap. The bitmap of the allocated block remains 0 (since allocation doesn't affect the bitmap) and the containing segment's (which we will call `blkh_seg`) `next_free` is advanced. 2. We enter the blackhole, evaluating the blackhole to produce a result (specificaly a cons cell) in the nursery 3. The blackhole gets updated into an indirection pointing to the cons cell; it is pushed to the generational remembered set 4. we perform a GC, the cons cell is evacuated into the nonmoving heap (into segment `cons_seg`) 5. the cons cell is marked 6. the GC concludes 7. the CAF and blackhole become unreachable 8. `cons_seg` is filled 9. we start another GC; the cons cell is swept 10. we start a new GC 11. something is evacuated into `blkh_seg`, adding it to the "todo" list 12. we attempt to scavenge `blkh_seg` (namely, all unmarked blocks between `scan` and `next_free`, which includes `blkh`). We attempt to evacuate `blkh`'s indirectee, which is the previously-swept cons cell. This is unsafe, since the indirectee is no longer a valid heap object. The problem here was that the scavenging logic *assumed* that (a) was the only source of allocations into the non-moving heap and therefore *all* unmarked blocks between `scan` and `next_free` were evacuated. However, due to (b) this is not true. The solution is to ensure that that the scanned region only encompasses the region of objects allocated during evacuation. We do this by updating `scan` as we push the segment to the todo-segment list to point to the block which was evacuated into. Doing this required changing the nonmoving scavenging implementation's update of the `scan` pointer to bump it *once*, instead of after scavenging each block as was done previously. This is because we may end up evacuating into the segment being scavenged as we scavenge it. This was quite tricky to discover but the result is quite simple, demonstrating yet again that global mutable state should be used exceedingly sparingly. Fixes #21885 (cherry picked from commit 0b27ea23efcb08639309293faf13fdfef03f1060) - - - - - 25c24535 by Ben Gamari at 2022-07-25T23:32:06-04:00 testsuite: Skip a few tests as in the nonmoving collector Residency monitoring under the non-moving collector is quite conservative (e.g. the reported value is larger than reality) since otherwise we would need to block on concurrent collection. Skip a few tests that are sensitive to residency. (cherry picked from commit 6880e4fbf728c04e8ce83e725bfc028fcb18cd70) - - - - - 42147534 by sternenseemann at 2022-07-26T16:26:53-04:00 hadrian: add flag disabling selftest rules which require QuickCheck The hadrian executable depends on QuickCheck for building, meaning this library (and its dependencies) will need to be built for bootstrapping GHC in the future. Building QuickCheck, however, can require TemplateHaskell. When building a statically linking GHC toolchain, TemplateHaskell can be tricky to get to work, and cross-compiling TemplateHaskell doesn't work at all without -fexternal-interpreter, so QuickCheck introduces an element of fragility to GHC's bootstrap. Since the selftest rules are the only part of hadrian that need QuickCheck, we can easily eliminate this bootstrap dependency when required by introducing a `selftest` flag guarding the rules' inclusion. Closes #8699. - - - - - 9ea29d47 by Simon Peyton Jones at 2022-07-26T16:27:28-04:00 Regression test for #21848 - - - - - ef30e215 by Matthew Pickering at 2022-07-28T13:56:59-04:00 driver: Don't create LinkNodes when -no-link is enabled Fixes #21866 - - - - - fc23b5ed by sheaf at 2022-07-28T13:57:38-04:00 Docs: fix mistaken claim about kind signatures This patch fixes #21806 by rectifying an incorrect claim about the usage of kind variables in the header of a data declaration with a standalone kind signature. It also adds some clarifications about the number of parameters expected in GADT declarations and in type family declarations. - - - - - 2df92ee1 by Matthew Pickering at 2022-08-02T05:20:01-04:00 testsuite: Correctly set withNativeCodeGen Fixes #21918 - - - - - f2912143 by Matthew Pickering at 2022-08-02T05:20:45-04:00 Fix since annotations in GHC.Stack.CloneStack Fixes #21894 - - - - - aeb8497d by Andreas Klebinger at 2022-08-02T19:26:51-04:00 Add -dsuppress-coercion-types to make coercions even smaller. Instead of `` `cast` <Co:11> :: (Some -> Really -> Large Type)`` simply print `` `cast` <Co:11> :: ... `` - - - - - 97655ad8 by sheaf at 2022-08-02T19:27:29-04:00 User's guide: fix typo in hasfield.rst Fixes #21950 - - - - - 35aef18d by Yiyun Liu at 2022-08-04T02:55:07-04:00 Remove TCvSubst and use Subst for both term and type-level subst This patch removes the TCvSubst data type and instead uses Subst as the environment for both term and type level substitution. This change is partially motivated by the existential type proposal, which will introduce types that contain expressions and therefore forces us to carry around an "IdSubstEnv" even when substituting for types. It also reduces the amount of code because "Subst" and "TCvSubst" share a lot of common operations. There isn't any noticeable impact on performance (geo. mean for ghc/alloc is around 0.0% but we have -94 loc and one less data type to worry abount). Currently, the "TCvSubst" data type for substitution on types is identical to the "Subst" data type except the former doesn't store "IdSubstEnv". Using "Subst" for type-level substitution means there will be a redundant field stored in the data type. However, in cases where the substitution starts from the expression, using "Subst" for type-level substitution saves us from having to project "Subst" into a "TCvSubst". This probably explains why the allocation is mostly even despite the redundant field. The patch deletes "TCvSubst" and moves "Subst" and its relevant functions from "GHC.Core.Subst" into "GHC.Core.TyCo.Subst". Substitution on expressions is still defined in "GHC.Core.Subst" so we don't have to expose the definition of "Expr" in the hs-boot file that "GHC.Core.TyCo.Subst" must import to refer to "IdSubstEnv" (whose codomain is "CoreExpr"). Most functions named fooTCvSubst are renamed into fooSubst with a few exceptions (e.g. "isEmptyTCvSubst" is a distinct function from "isEmptySubst"; the former ignores the emptiness of "IdSubstEnv"). These exceptions mainly exist for performance reasons and will go away when "Expr" and "Type" are mutually recursively defined (we won't be able to take those shortcuts if we can't make the assumption that expressions don't appear in types). - - - - - b99819bd by Krzysztof Gogolewski at 2022-08-04T02:55:43-04:00 Fix TH + defer-type-errors interaction (#21920) Previously, we had to disable defer-type-errors in splices because of #7276. But this fix is no longer necessary, the test T7276 no longer segfaults and is now correctly deferred. - - - - - fb529cae by Andreas Klebinger at 2022-08-04T13:57:25-04:00 Add a note about about W/W for unlifting strict arguments This fixes #21236. - - - - - fffc75a9 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force safeInferred to avoid retaining extra copy of DynFlags This will only have a (very) modest impact on memory but we don't want to retain old copies of DynFlags hanging around so best to force this value. - - - - - 0f43837f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force name selectors to ensure no reference to Ids enter the NameCache I observed some unforced thunks in the NameCache which were retaining a whole Id, which ends up retaining a Type.. which ends up retaining old copies of HscEnv containing stale HomeModInfo. - - - - - 0b1f5fd1 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Fix leaks in --make mode when there are module loops This patch fixes quite a tricky leak where we would end up retaining stale ModDetails due to rehydrating modules against non-finalised interfaces. == Loops with multiple boot files It is possible for a module graph to have a loop (SCC, when ignoring boot files) which requires multiple boot files to break. In this case we must perform the necessary hydration steps before and after compiling modules which have boot files which are described above for corectness but also perform an additional hydration step at the end of the SCC to remove space leaks. Consider the following example: ┌───────┐ ┌───────┐ │ │ │ │ │ A │ │ B │ │ │ │ │ └─────┬─┘ └───┬───┘ │ │ ┌────▼─────────▼──┐ │ │ │ C │ └────┬─────────┬──┘ │ │ ┌────▼──┐ ┌───▼───┐ │ │ │ │ │ A-boot│ │ B-boot│ │ │ │ │ └───────┘ └───────┘ A, B and C live together in a SCC. Say we compile the modules in order A-boot, B-boot, C, A, B then when we compile A we will perform the hydration steps (because A has a boot file). Therefore C will be hydrated relative to A, and the ModDetails for A will reference C/A. Then when B is compiled C will be rehydrated again, and so B will reference C/A,B, its interface will be hydrated relative to both A and B. Now there is a space leak because say C is a very big module, there are now two different copies of ModDetails kept alive by modules A and B. The way to avoid this space leak is to rehydrate an entire SCC together at the end of compilation so that all the ModDetails point to interfaces for .hs files. In this example, when we hydrate A, B and C together then both A and B will refer to C/A,B. See #21900 for some more discussion. ------------------------------------------------------- In addition to this simple case, there is also the potential for a leak during parallel upsweep which is also fixed by this patch. Transcibed is Note [ModuleNameSet, efficiency and space leaks] Note [ModuleNameSet, efficiency and space leaks] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ During unsweep the results of compiling modules are placed into a MVar, to find the environment the module needs to compile itself in the MVar is consulted and the HomeUnitGraph is set accordingly. The reason we do this is that precisely tracking module dependencies and recreating the HUG from scratch each time is very expensive. In serial mode (-j1), this all works out fine because a module can only be compiled after its dependencies have finished compiling and not interleaved with compiling module loops. Therefore when we create the finalised or no loop interfaces, the HUG only contains finalised interfaces. In parallel mode, we have to be more careful because the HUG variable can contain non-finalised interfaces which have been started by another thread. In order to avoid a space leak where a finalised interface is compiled against a HPT which contains a non-finalised interface we have to restrict the HUG to only the visible modules. The visible modules is recording in the ModuleNameSet, this is propagated upwards whilst compiling and explains which transitive modules are visible from a certain point. This set is then used to restrict the HUG before the module is compiled to only the visible modules and thus avoiding this tricky space leak. Efficiency of the ModuleNameSet is of utmost importance because a union occurs for each edge in the module graph. Therefore the set is represented directly as an IntSet which provides suitable performance, even using a UniqSet (which is backed by an IntMap) is too slow. The crucial test of performance here is the time taken to a do a no-op build in --make mode. See test "jspace" for an example which used to trigger this problem. Fixes #21900 - - - - - 1d94a59f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Store interfaces in ModIfaceCache more directly I realised hydration was completely irrelavant for this cache because the ModDetails are pruned from the result. So now it simplifies things a lot to just store the ModIface and Linkable, which we can put into the cache straight away rather than wait for the final version of a HomeModInfo to appear. - - - - - 6c7cd50f by Cheng Shao at 2022-08-04T23:01:45-04:00 cmm: Remove unused ReadOnlyData16 We don't actually emit rodata16 sections anywhere. - - - - - 16333ad7 by Andreas Klebinger at 2022-08-04T23:02:20-04:00 findExternalRules: Don't needlessly traverse the list of rules. - - - - - 52c15674 by Krzysztof Gogolewski at 2022-08-05T12:47:05-04:00 Remove backported items from 9.6 release notes They have been backported to 9.4 in commits 5423d84bd9a28f, 13c81cb6be95c5, 67ccbd6b2d4b9b. - - - - - 78d232f5 by Matthew Pickering at 2022-08-05T12:47:40-04:00 ci: Fix pages job The job has been failing because we don't bundle haddock docs anymore in the docs dist created by hadrian. Fixes #21789 - - - - - 037bc9c9 by Ben Gamari at 2022-08-05T22:00:29-04:00 codeGen/X86: Don't clobber switch variable in switch generation Previously ce8745952f99174ad9d3bdc7697fd086b47cdfb5 assumed that it was safe to clobber the switch variable when generating code for a jump table since we were at the end of a block. However, this assumption is wrong; the register could be live in the jump target. Fixes #21968. - - - - - 50c8e1c5 by Matthew Pickering at 2022-08-05T22:01:04-04:00 Fix equality operator in jspace test - - - - - e9c77a22 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Improve BUILD_PAP comments - - - - - 41234147 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Make dropTail comment a haddock comment - - - - - ff11d579 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Add one more sanity check in stg_restore_cccs - - - - - 1f6c56ae by Andreas Klebinger at 2022-08-06T06:13:17-04:00 StgToCmm: Fix isSimpleScrut when profiling is enabled. When profiling is enabled we must enter functions that might represent thunks in order for their sccs to show up in the profile. We might allocate even if the function is already evaluated in this case. So we can't consider any potential function thunk to be a simple scrut when profiling. Not doing so caused profiled binaries to segfault. - - - - - fab0ee93 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Change `-fprof-late` to insert cost centres after unfolding creation. The former behaviour of adding cost centres after optimization but before unfoldings are created is not available via the flag `prof-late-inline` instead. I also reduced the overhead of -fprof-late* by pushing the cost centres into lambdas. This means the cost centres will only account for execution of functions and not their partial application. Further I made LATE_CC cost centres it's own CC flavour so they now won't clash with user defined ones if a user uses the same string for a custom scc. LateCC: Don't put cost centres inside constructor workers. With -fprof-late they are rarely useful as the worker is usually inlined. Even if the worker is not inlined or we use -fprof-late-linline they are generally not helpful but bloat compile and run time significantly. So we just don't add sccs inside constructor workers. ------------------------- Metric Decrease: T13701 ------------------------- - - - - - f8bec4e3 by Ben Gamari at 2022-08-06T06:13:53-04:00 gitlab-ci: Fix hadrian bootstrapping of release pipelines Previously we would attempt to test hadrian bootstrapping in the `validate` build flavour. However, `ci.sh` refuses to run validation builds during release pipelines, resulting in job failures. Fix this by testing bootstrapping in the `release` flavour during release pipelines. We also attempted to record perf notes for these builds, which is redundant work and undesirable now since we no longer build in a consistent flavour. - - - - - c0348865 by Ben Gamari at 2022-08-06T11:45:17-04:00 compiler: Eliminate two uses of foldr in favor of foldl' These two uses constructed maps, which is a case where foldl' is generally more efficient since we avoid constructing an intermediate O(n)-depth stack. - - - - - d2e4e123 by Ben Gamari at 2022-08-06T11:45:17-04:00 rts: Fix code style - - - - - 57f530d3 by Ben Gamari at 2022-08-06T11:45:17-04:00 genprimopcode: Drop ArrayArray# references As ArrayArray# no longer exists - - - - - 7267cd52 by Ben Gamari at 2022-08-06T11:45:17-04:00 base: Organize Haddocks in GHC.Conc.Sync - - - - - aa818a9f by Ben Gamari at 2022-08-06T11:48:50-04:00 Add primop to list threads A user came to #ghc yesterday wondering how best to check whether they were leaking threads. We ended up using the eventlog but it seems to me like it would be generally useful if Haskell programs could query their own threads. - - - - - 6d1700b6 by Ben Gamari at 2022-08-06T11:51:35-04:00 rts: Move thread labels into TSO This eliminates the thread label HashTable and instead tracks this information in the TSO, allowing us to use proper StgArrBytes arrays for backing the label and greatly simplifying management of object lifetimes when we expose them to the user with the coming `threadLabel#` primop. - - - - - 1472044b by Ben Gamari at 2022-08-06T11:54:52-04:00 Add a primop to query the label of a thread - - - - - 43f2b271 by Ben Gamari at 2022-08-06T11:55:14-04:00 base: Share finalization thread label For efficiency's sake we float the thread label assigned to the finalization thread to the top-level, ensuring that we only need to encode the label once. - - - - - 1d63b4fb by Ben Gamari at 2022-08-06T11:57:11-04:00 users-guide: Add release notes entry for thread introspection support - - - - - 09bca1de by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix binary distribution install attributes Previously we would use plain `cp` to install various parts of the binary distribution. However, `cp`'s behavior w.r.t. file attributes is quite unclear; for this reason it is much better to rather use `install`. Fixes #21965. - - - - - 2b8ea16d by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix installation of system-cxx-std-lib package conf - - - - - 7b514848 by Ben Gamari at 2022-08-07T01:20:10-04:00 gitlab-ci: Bump Docker images To give the ARMv7 job access to lld, fixing #21875. - - - - - afa584a3 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Don't use mk/config.mk.in Ultimately we want to drop mk/config.mk so here I extract the bits needed by the Hadrian bindist installation logic into a Hadrian-specific file. While doing this I fixed binary distribution installation, #21901. - - - - - b9bb45d7 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Fix naming of cross-compiler wrappers - - - - - 78d04cfa by Ben Gamari at 2022-08-07T11:44:58-04:00 hadrian: Extend xattr Darwin hack to cover /lib As noted in #21506, it is now necessary to remove extended attributes from `/lib` as well as `/bin` to avoid SIP issues on Darwin. Fixes #21506. - - - - - 20457d77 by Andreas Klebinger at 2022-08-08T14:42:26+02:00 NCG(x86): Compile add+shift as lea if possible. - - - - - 742292e4 by Andreas Klebinger at 2022-08-08T16:46:37-04:00 dataToTag#: Skip runtime tag check if argument is infered tagged This addresses one part of #21710. - - - - - 1504a93e by Cheng Shao at 2022-08-08T16:47:14-04:00 rts: remove redundant stg_traceCcszh This out-of-line primop has no Haskell wrapper and hasn't been used anywhere in the tree. Furthermore, the code gets in the way of !7632, so it should be garbage collected. - - - - - a52de3cb by Andreas Klebinger at 2022-08-08T16:47:50-04:00 Document a divergence from the report in parsing function lhss. GHC is happy to parse `(f) x y = x + y` when it should be a parse error based on the Haskell report. Seems harmless enough so we won't fix it but it's documented now. Fixes #19788 - - - - - 5765e133 by Ben Gamari at 2022-08-08T16:48:25-04:00 gitlab-ci: Add release job for aarch64/debian 11 - - - - - 5b26f324 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Introduce validation job for aarch64 cross-compilation Begins to address #11958. - - - - - e866625c by Ben Gamari at 2022-08-08T19:39:20-04:00 Bump process submodule - - - - - ae707762 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - 50912d68 by Ben Gamari at 2022-08-08T19:39:57-04:00 rts: Ensure that Array# card arrays are initialized In #19143 I noticed that newArray# failed to initialize the card table of newly-allocated arrays. However, embarrassingly, I then only fixed the issue in newArrayArray# and, in so doing, introduced the potential for an integer underflow on zero-length arrays (#21962). Here I fix the issue in newArray#, this time ensuring that we do not underflow in pathological cases. Fixes #19143. - - - - - e5ceff56 by Ben Gamari at 2022-08-08T19:39:57-04:00 testsuite: Add test for #21962 - - - - - c1c08bd8 by Ben Gamari at 2022-08-09T02:31:14-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 1c582f44 by Ben Gamari at 2022-08-09T02:31:14-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 681aa076 by Ben Gamari at 2022-08-09T02:31:49-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - e9dfd26a by Krzysztof Gogolewski at 2022-08-09T02:32:24-04:00 Cleanups around pretty-printing * Remove hack when printing OccNames. No longer needed since e3dcc0d5 * Remove unused `pprCmms` and `instance Outputable Instr` * Simplify `pprCLabel` (no need to pass platform) * Remove evil `Show`/`Eq` instances for `SDoc`. They were needed by ImmLit, but that can take just a String instead. * Remove instance `Outputable CLabel` - proper output of labels needs a platform, and is done by the `OutputableP` instance - - - - - 66d2e927 by Ben Gamari at 2022-08-09T13:46:48-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 5d66a0ce by Ben Gamari at 2022-08-09T13:46:48-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - ea90e61d by Ben Gamari at 2022-08-09T13:46:48-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - d71a2051 by sheaf at 2022-08-09T13:47:28-04:00 Fix size_up_alloc to account for UnliftedDatatypes The size_up_alloc function mistakenly considered any type that isn't lifted to not allocate anything, which is wrong. What we want instead is to check the type isn't boxed. This accounts for (BoxedRep Unlifted). Fixes #21939 - - - - - 76b52cf0 by Douglas Wilson at 2022-08-10T06:01:53-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. - - - - - 7589ee72 by Douglas Wilson at 2022-08-10T06:01:53-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. - - - - - dc76439d by Trevis Elser at 2022-08-10T06:02:28-04:00 Updates language extension documentation Adding a 'Status' field with a few values: - Deprecated - Experimental - InternalUseOnly - Noting if included in 'GHC2021', 'Haskell2010' or 'Haskell98' Those values are pulled from the existing descriptions or elsewhere in the documentation. While at it, include the :implied by: where appropriate, to provide more detail. Fixes #21475 - - - - - 823fe5b5 by Jens Petersen at 2022-08-10T06:03:07-04:00 hadrian RunRest: add type signature for stageNumber avoids warning seen on 9.4.1: src/Settings/Builders/RunTest.hs:264:53: warning: [-Wtype-defaults] • Defaulting the following constraints to type ‘Integer’ (Show a0) arising from a use of ‘show’ at src/Settings/Builders/RunTest.hs:264:53-84 (Num a0) arising from a use of ‘stageNumber’ at src/Settings/Builders/RunTest.hs:264:59-83 • In the second argument of ‘(++)’, namely ‘show (stageNumber (C.stage ctx))’ In the second argument of ‘($)’, namely ‘"config.stage=" ++ show (stageNumber (C.stage ctx))’ In the expression: arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | 264 | , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ compilation tested locally - - - - - f95bbdca by Sylvain Henry at 2022-08-10T09:44:46-04:00 Add support for external static plugins (#20964) This patch adds a new command-line flag: -fplugin-library=<file-path>;<unit-id>;<module>;<args> used like this: -fplugin-library=path/to/plugin.so;package-123;Plugin.Module;["Argument","List"] It allows a plugin to be loaded directly from a shared library. With this approach, GHC doesn't compile anything for the plugin and doesn't load any .hi file for the plugin and its dependencies. As such GHC doesn't need to support two environments (one for plugins, one for target code), which was the more ambitious approach tracked in #14335. Fix #20964 Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 5bc489ca by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Fix ARMv7 build It appears that the CI refactoring carried out in 5ff690b8474c74e9c968ef31e568c1ad0fe719a1 failed to carry over some critical configuration: setting the build/host/target platforms and forcing use of a non-broken linker. - - - - - 596db9a5 by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Run ARMv7 jobs when ~ARM label is used - - - - - 7cabea7c by Ben Gamari at 2022-08-10T15:37:58-04:00 hadrian: Don't attempt to install documentation if doc/ doesn't exist Previously we would attempt to install documentation even if the `doc` directory doesn't exist (e.g. due to `--docs=none`). This would result in the surprising side-effect of the entire contents of the bindist being installed in the destination documentation directory. Fix this. Fixes #21976. - - - - - 67575f20 by normalcoder at 2022-08-10T15:38:34-04:00 ncg/aarch64: Don't use x18 register on AArch64/Darwin Apple's ABI documentation [1] says: "The platforms reserve register x18. Don’t use this register." While this wasn't problematic in previous Darwin releases, macOS 13 appears to start zeroing this register periodically. See #21964. [1] https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms - - - - - 45eb4cbe by Andreas Klebinger at 2022-08-10T22:41:12-04:00 Note [Trimming auto-rules]: State that this improves compiler perf. - - - - - 5c24b1b3 by Bodigrim at 2022-08-10T22:41:50-04:00 Document that threadDelay / timeout are susceptible to overflows on 32-bit machines - - - - - ff67c79e by Alan Zimmerman at 2022-08-11T16:19:57-04:00 EPA: DotFieldOcc does not have exact print annotations For the code {-# LANGUAGE OverloadedRecordUpdate #-} operatorUpdate f = f{(+) = 1} There are no exact print annotations for the parens around the + symbol, nor does normal ppr print them. This MR fixes that. Closes #21805 Updates haddock submodule - - - - - dca43a04 by Matthew Pickering at 2022-08-11T16:20:33-04:00 Revert "gitlab-ci: Add release job for aarch64/debian 11" This reverts commit 5765e13370634979eb6a0d9f67aa9afa797bee46. The job was not tested before being merged and fails CI (https://gitlab.haskell.org/ghc/ghc/-/jobs/1139392) Ticket #22005 - - - - - ffc9116e by Eric Lindblad at 2022-08-16T09:01:26-04:00 typo - - - - - cd6f5bfd by Ben Gamari at 2022-08-16T09:02:02-04:00 CmmToLlvm: Don't aliasify builtin LLVM variables Our aliasification logic would previously turn builtin LLVM variables into aliases, which apparently confuses LLVM. This manifested in initializers failing to be emitted, resulting in many profiling failures with the LLVM backend. Fixes #22019. - - - - - dc7da356 by Bryan Richter at 2022-08-16T09:02:38-04:00 run_ci: remove monoidal-containers Fixes #21492 MonoidalMap is inlined and used to implement Variables, as before. The top-level value "jobs" is reimplemented as a regular Map, since it doesn't use the monoidal union anyway. - - - - - 64110544 by Cheng Shao at 2022-08-16T09:03:15-04:00 CmmToAsm/AArch64: correct a typo - - - - - f6a5524a by Andreas Klebinger at 2022-08-16T14:34:11-04:00 Fix #21979 - compact-share failing with -O I don't have good reason to believe the optimization level should affect if sharing works or not here. So limit the test to the normal way. - - - - - 68154a9d by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix reference to dead llvm-version substitution Fixes #22052. - - - - - 28c60d26 by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix incorrect reference to `:extension: role - - - - - 71102c8f by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Add :ghc-flag: reference - - - - - 385f420b by Ben Gamari at 2022-08-16T14:34:47-04:00 hadrian: Place manpage in docroot This relocates it from docs/ to doc/ - - - - - 84598f2e by Ben Gamari at 2022-08-16T14:34:47-04:00 Bump haddock submodule Includes merge of `main` into `ghc-head` as well as some Haddock users guide fixes. - - - - - 59ce787c by Ben Gamari at 2022-08-16T14:34:47-04:00 base: Add changelog entries from ghc-9.2 Closes #21922. - - - - - a14e6ae3 by Ben Gamari at 2022-08-16T14:34:47-04:00 relnotes: Add "included libraries" section As noted in #21988, some users rely on this. - - - - - a4212edc by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Rephrase the rewrite rule documentation Previously the wording was a tad unclear. Fix this. Closes #21114. - - - - - 3e493dfd by Peter Becich at 2022-08-17T08:43:21+01:00 Implement Response File support for HPC This is an improvement to HPC authored by Richard Wallace (https://github.com/purefn) and myself. I have received permission from him to attempt to upstream it. This improvement was originally implemented as a patch to HPC via input-output-hk/haskell.nix: https://github.com/input-output-hk/haskell.nix/pull/1464 Paraphrasing Richard, HPC currently requires all inputs as command line arguments. With large projects this can result in an argument list too long error. I have only seen this error in Nix, but I assume it can occur is a plain Unix environment. This MR adds the standard response file syntax support to HPC. For example you can now pass a file to the command line which contains the arguments. ``` hpc @response_file_1 @response_file_2 ... The contents of a Response File must have this format: COMMAND ... example: report my_library.tix --include=ModuleA --include=ModuleB ``` Updates hpc submodule Co-authored-by: Richard Wallace <rwallace at thewallacepack.net> Fixes #22050 - - - - - 436867d6 by Matthew Pickering at 2022-08-18T09:24:08-04:00 ghc-heap: Fix decoding of TSO closures An extra field was added to the TSO structure in 6d1700b6 but the decoding logic in ghc-heap was not updated for this new field. Fixes #22046 - - - - - a740a4c5 by Matthew Pickering at 2022-08-18T09:24:44-04:00 driver: Honour -x option The -x option is used to manually specify which phase a file should be started to be compiled from (even if it lacks the correct extension). I just failed to implement this when refactoring the driver. In particular Cabal calls GHC with `-E -cpp -x hs Foo.cpphs` to preprocess source files using GHC. I added a test to exercise this case. Fixes #22044 - - - - - e293029d by Simon Peyton Jones at 2022-08-18T09:25:19-04:00 Be more careful in chooseInferredQuantifiers This fixes #22065. We were failing to retain a quantifier that was mentioned in the kind of another retained quantifier. Easy to fix. - - - - - 714c936f by Bryan Richter at 2022-08-18T18:37:21-04:00 testsuite: Add test for #21583 - - - - - 989b844d by Ben Gamari at 2022-08-18T18:37:57-04:00 compiler: Drop --build-id=none hack Since 2011 the object-joining implementation has had a hack to pass `--build-id=none` to `ld` when supported, seemingly to work around a linker bug. This hack is now unnecessary and may break downstream users who expect objects to have valid build-ids. Remove it. Closes #22060. - - - - - 519c712e by Matthew Pickering at 2022-08-19T00:09:11-04:00 Make ru_fn field strict to avoid retaining Ids It's better to perform this projection from Id to Name strictly so we don't retain an old Id (hence IdInfo, hence Unfolding, hence everything etc) - - - - - 7dda04b0 by Matthew Pickering at 2022-08-19T00:09:11-04:00 Force `getOccFS bndr` to avoid retaining reference to Bndr. This is another symptom of #19619 - - - - - 4303acba by Matthew Pickering at 2022-08-19T00:09:11-04:00 Force unfoldings when they are cleaned-up in Tidy and CorePrep If these thunks are not forced then the entire unfolding for the binding is live throughout the whole of CodeGen despite the fact it should have been discarded. Fixes #22071 - - - - - 2361b3bc by Matthew Pickering at 2022-08-19T00:09:47-04:00 haddock docs: Fix links from identifiers to dependent packages When implementing the base_url changes I made the pretty bad mistake of zipping together two lists which were in different orders. The simpler thing to do is just modify `haddockDependencies` to also return the package identifier so that everything stays in sync. Fixes #22001 - - - - - 9a7e2ea1 by Matthew Pickering at 2022-08-19T00:10:23-04:00 Revert "Refactor SpecConstr to use treat bindings uniformly" This reverts commit 415468fef8a3e9181b7eca86de0e05c0cce31729. This refactoring introduced quite a severe residency regression (900MB live from 650MB live when compiling mmark), see #21993 for a reproducer and more discussion. Ticket #21993 - - - - - 9789e845 by Zachary Wood at 2022-08-19T14:17:28-04:00 tc: warn about lazy annotations on unlifted arguments (fixes #21951) - - - - - e5567289 by Andreas Klebinger at 2022-08-19T14:18:03-04:00 Fix #22048 where we failed to drop rules for -fomit-interface-pragmas. Now we also filter the local rules (again) which fixes the issue. - - - - - 51ffd009 by Swann Moreau at 2022-08-19T18:29:21-04:00 Print constraints in quotes (#21167) This patch improves the uniformity of error message formatting by printing constraints in quotes, as we do for types. Fix #21167 - - - - - ab3e0f5a by Sasha Bogicevic at 2022-08-19T18:29:57-04:00 19217 Implicitly quantify type variables in :kind command - - - - - 9939e95f by MorrowM at 2022-08-21T16:51:38-04:00 Recognize file-header pragmas in GHCi (#21507) - - - - - fb7c2d99 by Matthew Pickering at 2022-08-21T16:52:13-04:00 hadrian: Fix bootstrapping with ghc-9.4 The error was that we were trying to link together containers from boot package library (which depends template-haskell in boot package library) template-haskell from in-tree package database So the fix is to build containers in stage0 (and link against template-haskell built in stage0). Fixes #21981 - - - - - b946232c by Mario Blažević at 2022-08-22T22:06:21-04:00 Added pprType with precedence argument, as a prerequisite to fix issues #21723 and #21942. * refines the precedence levels, adding `qualPrec` and `funPrec` to better control parenthesization * `pprParendType`, `pprFunArgType`, and `instance Ppr Type` all just call `pprType` with proper precedence * `ParensT` constructor is now always printed parenthesized * adds the precedence argument to `pprTyApp` as well, as it needs to keep track and pass it down * using `>=` instead of former `>` to match the Core type printing logic * some test outputs have changed, losing extraneous parentheses - - - - - fe4ff0f7 by Mario Blažević at 2022-08-22T22:06:21-04:00 Fix and test for issue #21723 - - - - - 33968354 by Mario Blažević at 2022-08-22T22:06:21-04:00 Test for issue #21942 - - - - - c9655251 by Mario Blažević at 2022-08-22T22:06:21-04:00 Updated the changelog - - - - - 80102356 by Ben Gamari at 2022-08-22T22:06:57-04:00 hadrian: Don't duplicate binaries on installation Previously we used `install` on symbolic links, which ended up copying the target file rather than installing a symbolic link. Fixes #22062. - - - - - b929063e by M Farkas-Dyck at 2022-08-24T02:37:01-04:00 Unbreak Haddock comments in `GHC.Core.Opt.WorkWrap.Utils`. Closes #22092. - - - - - 112e4f9c by Cheng Shao at 2022-08-24T02:37:38-04:00 driver: don't actually merge objects when ar -L works - - - - - a9f0e68e by Ben Gamari at 2022-08-24T02:38:13-04:00 rts: Consistently use MiB in stats output Previously we would say `MB` even where we meant `MiB`. - - - - - a90298cc by Simon Peyton Jones at 2022-08-25T08:38:16+01:00 Fix arityType: -fpedantic-bottoms, join points, etc This MR fixes #21694, #21755. It also makes sure that #21948 and fix to #21694. * For #21694 the underlying problem was that we were calling arityType on an expression that had free join points. This is a Bad Bad Idea. See Note [No free join points in arityType]. * To make "no free join points in arityType" work out I had to avoid trying to use eta-expansion for runRW#. This entailed a few changes in the Simplifier's treatment of runRW#. See GHC.Core.Opt.Simplify.Iteration Note [No eta-expansion in runRW#] * I also made andArityType work correctly with -fpedantic-bottoms; see Note [Combining case branches: andWithTail]. * Rewrote Note [Combining case branches: optimistic one-shot-ness] * arityType previously treated join points differently to other let-bindings. This patch makes them unform; arityType analyses the RHS of all bindings to get its ArityType, and extends am_sigs. I realised that, now we have am_sigs giving the ArityType for let-bound Ids, we don't need the (pre-dating) special code in arityType for join points. But instead we need to extend the env for Rec bindings, which weren't doing before. More uniform now. See Note [arityType for let-bindings]. This meant we could get rid of ae_joins, and in fact get rid of EtaExpandArity altogether. Simpler. * And finally, it was the strange treatment of join-point Ids in arityType (involving a fake ABot type) that led to a serious bug: #21755. Fixed by this refactoring, which treats them uniformly; but without breaking #18328. In fact, the arity for recursive join bindings is pretty tricky; see the long Note [Arity for recursive join bindings] in GHC.Core.Opt.Simplify.Utils. That led to more refactoring, including deciding that an Id could have an Arity that is bigger than its JoinArity; see Note [Invariants on join points], item 2(b) in GHC.Core * Make sure that the "demand threshold" for join points in DmdAnal is no bigger than the join-arity. In GHC.Core.Opt.DmdAnal see Note [Demand signatures are computed for a threshold arity based on idArity] * I moved GHC.Core.Utils.exprIsDeadEnd into GHC.Core.Opt.Arity, where it more properly belongs. * Remove an old, redundant hack in FloatOut. The old Note was Note [Bottoming floats: eta expansion] in GHC.Core.Opt.SetLevels. Compile time improves very slightly on average: Metrics: compile_time/bytes allocated --------------------------------------------------------------------------------------- T18223(normal) ghc/alloc 725,808,720 747,839,216 +3.0% BAD T6048(optasm) ghc/alloc 105,006,104 101,599,472 -3.2% GOOD geo. mean -0.2% minimum -3.2% maximum +3.0% For some reason Windows was better T10421(normal) ghc/alloc 125,888,360 124,129,168 -1.4% GOOD T18140(normal) ghc/alloc 85,974,520 83,884,224 -2.4% GOOD T18698b(normal) ghc/alloc 236,764,568 234,077,288 -1.1% GOOD T18923(normal) ghc/alloc 75,660,528 73,994,512 -2.2% GOOD T6048(optasm) ghc/alloc 112,232,512 108,182,520 -3.6% GOOD geo. mean -0.6% I had a quick look at T18223 but it is knee deep in coercions and the size of everything looks similar before and after. I decided to accept that 3% increase in exchange for goodness elsewhere. Metric Decrease: T10421 T18140 T18698b T18923 T6048 Metric Increase: T18223 - - - - - 909edcfc by Ben Gamari at 2022-08-25T10:03:34-04:00 upload_ghc_libs: Add means of passing Hackage credentials - - - - - 28402eed by M Farkas-Dyck at 2022-08-25T10:04:17-04:00 Scrub some partiality in `CommonBlockElim`. - - - - - 54affbfa by Ben Gamari at 2022-08-25T20:05:31-04:00 hadrian: Fix whitespace Previously this region of Settings.Packages was incorrectly indented. - - - - - c4bba0f0 by Ben Gamari at 2022-08-25T20:05:31-04:00 validate: Drop --legacy flag In preparation for removal of the legacy `make`-based build system. - - - - - 822b0302 by Ben Gamari at 2022-08-25T20:05:31-04:00 gitlab-ci: Drop make build validation jobs In preparation for removal of the `make`-based build system - - - - - 6fd9b0a1 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop make build system Here we at long last remove the `make`-based build system, it having been replaced with the Shake-based Hadrian build system. Users are encouraged to refer to the documentation in `hadrian/doc` and this [1] blog post for details on using Hadrian. Closes #17527. [1] https://www.haskell.org/ghc/blog/20220805-make-to-hadrian.html - - - - - dbb004b0 by Ben Gamari at 2022-08-25T20:05:31-04:00 Remove testsuite/tests/perf/haddock/.gitignore As noted in #16802, this is no longer needed. Closes #16802. - - - - - fe9d824d by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop hc-build script This has not worked for many, many years and relied on the now-removed `make`-based build system. - - - - - 659502bc by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mkdirhier This is only used by nofib's dead `dist` target - - - - - 4a426924 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mk/{build,install,config}.mk.in - - - - - 46924b75 by Ben Gamari at 2022-08-25T20:05:31-04:00 compiler: Drop comment references to make - - - - - d387f687 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add inits1 and tails1 to Data.List.NonEmpty See https://github.com/haskell/core-libraries-committee/issues/67 - - - - - 8603c921 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add since annotations and changelog entries - - - - - 6b47aa1c by Krzysztof Gogolewski at 2022-08-25T20:06:46-04:00 Fix redundant import This fixes a build error on x86_64-linux-alpine3_12-validate. See the function 'loadExternalPlugins' defined in this file. - - - - - 4786acf7 by sheaf at 2022-08-26T15:05:23-04:00 Pmc: consider any 2 dicts of the same type equal This patch massages the keys used in the `TmOracle` `CoreMap` to ensure that dictionaries of coherent classes give the same key. That is, whenever we have an expression we want to insert or lookup in the `TmOracle` `CoreMap`, we first replace any dictionary `$dict_abcd :: ct` with a value of the form `error @ct`. This allows us to common-up view pattern functions with required constraints whose arguments differed only in the uniques of the dictionaries they were provided, thus fixing #21662. This is a rather ad-hoc change to the keys used in the `TmOracle` `CoreMap`. In the long run, we would probably want to use a different representation for the keys instead of simply using `CoreExpr` as-is. This more ambitious plan is outlined in #19272. Fixes #21662 Updates unix submodule - - - - - f5e0f086 by Krzysztof Gogolewski at 2022-08-26T15:06:01-04:00 Remove label style from printing context Previously, the SDocContext used for code generation contained information whether the labels should use Asm or C style. However, at every individual call site, this is known statically. This removes the parameter to 'PprCode' and replaces every 'pdoc' used to print a label in code style with 'pprCLabel' or 'pprAsmLabel'. The OutputableP instance is now used only for dumps. The output of T15155 changes, it now uses the Asm style (which is faithful to what actually happens). - - - - - 1007829b by Cheng Shao at 2022-08-26T15:06:40-04:00 boot: cleanup legacy args Cleanup legacy boot script args, following removal of the legacy make build system. - - - - - 95fe09da by Simon Peyton Jones at 2022-08-27T00:29:02-04:00 Improve SpecConstr for evals As #21763 showed, we were over-specialising in some cases, when the function involved was doing a simple 'eval', but not taking the value apart, or branching on it. This MR fixes the problem. See Note [Do not specialise evals]. Nofib barely budges, except that spectral/cichelli allocates about 3% less. Compiler bytes-allocated improves a bit geo. mean -0.1% minimum -0.5% maximum +0.0% The -0.5% is on T11303b, for what it's worth. - - - - - 565a8ec8 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Revert "Revert "Refactor SpecConstr to use treat bindings uniformly"" This reverts commit 851d8dd89a7955864b66a3da8b25f1dd88a503f8. This commit was originally reverted due to an increase in space usage. This was diagnosed as because the SCE increased in size and that was being retained by another leak. See #22102 - - - - - 82ce1654 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Avoid retaining bindings via ModGuts held on the stack It's better to overwrite the bindings fields of the ModGuts before starting an iteration as then all the old bindings can be collected as soon as the simplifier has processed them. Otherwise we end up with the old bindings being alive until right at the end of the simplifier pass as the mg_binds field is only modified right at the end. - - - - - 64779dcd by Matthew Pickering at 2022-08-27T00:29:39-04:00 Force imposs_deflt_cons in filterAlts This fixes a pretty serious space leak as the forced thunk would retain `Alt b` values which would then contain reference to a lot of old bindings and other simplifier gunk. The OtherCon unfolding was not forced on subsequent simplifier runs so more and more old stuff would be retained until the end of simplification. Fixing this has a drastic effect on maximum residency for the mmark package which goes from ``` 45,005,401,056 bytes allocated in the heap 17,227,721,856 bytes copied during GC 818,281,720 bytes maximum residency (33 sample(s)) 9,659,144 bytes maximum slop 2245 MiB total memory in use (0 MB lost due to fragmentation) ``` to ``` 45,039,453,304 bytes allocated in the heap 13,128,181,400 bytes copied during GC 331,546,608 bytes maximum residency (40 sample(s)) 7,471,120 bytes maximum slop 916 MiB total memory in use (0 MB lost due to fragmentation) ``` See #21993 for some more discussion. - - - - - a3b23a33 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Use Solo to avoid retaining the SCE but to avoid performing the substitution The use of Solo here allows us to force the selection into the SCE to obtain the Subst but without forcing the substitution to be applied. The resulting thunk is placed into a lazy field which is rarely forced, so forcing it regresses peformance. - - - - - 161a6f1f by Simon Peyton Jones at 2022-08-27T00:30:14-04:00 Fix a nasty loop in Tidy As the remarkably-simple #22112 showed, we were making a black hole in the unfolding of a self-recursive binding. Boo! It's a bit tricky. Documented in GHC.Iface.Tidy, Note [tidyTopUnfolding: avoiding black holes] - - - - - 68e6786f by Giles Anderson at 2022-08-29T00:01:35+02:00 Use TcRnDiagnostic in GHC.Tc.TyCl.Class (#20117) The following `TcRnDiagnostic` messages have been introduced: TcRnIllegalHsigDefaultMethods TcRnBadGenericMethod TcRnWarningMinimalDefIncomplete TcRnDefaultMethodForPragmaLacksBinding TcRnIgnoreSpecialisePragmaOnDefMethod TcRnBadMethodErr TcRnNoExplicitAssocTypeOrDefaultDeclaration - - - - - cbe51ac5 by Simon Peyton Jones at 2022-08-29T04:18:57-04:00 Fix a bug in anyInRnEnvR This bug was a subtle error in anyInRnEnvR, introduced by commit d4d3fe6e02c0eb2117dbbc9df72ae394edf50f06 Author: Andreas Klebinger <klebinger.andreas at gmx.at> Date: Sat Jul 9 01:19:52 2022 +0200 Rule matching: Don't compute the FVs if we don't look at them. The net result was #22028, where a rewrite rule would wrongly match on a lambda. The fix to that function is easy. - - - - - 0154bc80 by sheaf at 2022-08-30T06:05:41-04:00 Various Hadrian bootstrapping fixes - Don't always produce a distribution archive (#21629) - Use correct executable names for ghc-pkg and hsc2hs on windows (we were missing the .exe file extension) - Fix a bug where we weren't using the right archive format on Windows when unpacking the bootstrap sources. Fixes #21629 - - - - - 451b1d90 by Matthew Pickering at 2022-08-30T06:06:16-04:00 ci: Attempt using normal submodule cloning strategy We do not use any recursively cloned submodules, and this protects us from flaky upstream remotes. Fixes #22121 - - - - - 9d5ad7c4 by Pi Delport at 2022-08-30T22:40:46+00:00 Fix typo in Any docs: stray "--" - - - - - 3a002632 by Pi Delport at 2022-08-30T22:40:46+00:00 Fix typo in Any docs: syntatic -> syntactic - - - - - 7f490b13 by Simon Peyton Jones at 2022-08-31T03:53:54-04:00 Add a missing trimArityType This buglet was exposed by #22114, a consequence of my earlier refactoring of arity for join points. - - - - - e6fc820f by Ben Gamari at 2022-08-31T13:16:01+01:00 Bump binary submodule to 0.8.9.1 - - - - - 4c1e7b22 by Ben Gamari at 2022-08-31T13:16:01+01:00 Bump stm submodule to 2.5.1.0 - - - - - 837472b4 by Ben Gamari at 2022-08-31T13:16:01+01:00 users-guide: Document system-cxx-std-lib - - - - - f7a9947a by Douglas Wilson at 2022-08-31T13:16:01+01:00 Update submodule containers to 0.6.6 - - - - - 4ab1c2ca by Douglas Wilson at 2022-08-31T13:16:02+01:00 Update submodule process to 1.6.15.0 - - - - - 1309ea1e by Ben Gamari at 2022-08-31T13:16:02+01:00 Bump directory submodule to 1.3.7.1 - - - - - 7962a33a by Douglas Wilson at 2022-08-31T13:16:02+01:00 Bump text submodule to 2.0.1 - - - - - fd8d80c3 by Ben Gamari at 2022-08-31T13:26:52+01:00 Bump deepseq submodule to 1.4.8.0 - - - - - a9baafac by Ben Gamari at 2022-08-31T13:26:52+01:00 Add dates to base, ghc-prim changelogs - - - - - 2cee323c by Ben Gamari at 2022-08-31T13:26:52+01:00 Update autoconf scripts Scripts taken from autoconf 02ba26b218d3d3db6c56e014655faf463cefa983 - - - - - e62705ff by Ben Gamari at 2022-08-31T13:26:53+01:00 Bump bytestring submodule to 0.11.3.1 - - - - - f7b4dcbd by Douglas Wilson at 2022-08-31T13:26:53+01:00 Update submodule Cabal to tag Cabal-v3.8.1.0 closes #21931 - - - - - e8eaf807 by Matthew Pickering at 2022-08-31T18:27:57-04:00 Refine in-tree compiler args for --test-compiler=stage1 Some of the logic to calculate in-tree arguments was not correct for the stage1 compiler. Namely we were not correctly reporting whether we were building static or dynamic executables and whether debug assertions were enabled. Fixes #22096 - - - - - 6b2f7ffe by Matthew Pickering at 2022-08-31T18:27:57-04:00 Make ghcDebugAssertions into a Stage predicate (Stage -> Bool) We also care whether we have debug assertions enabled for a stage one compiler, but the way which we turned on the assertions was quite different from the stage2 compiler. This makes the logic for turning on consistent across both and has the advantage of being able to correct determine in in-tree args whether a flavour enables assertions or not. Ticket #22096 - - - - - 15111af6 by Zubin Duggal at 2022-09-01T01:18:50-04:00 Add regression test for #21550 This was fixed by ca90ffa321a31842a32be1b5b6e26743cd677ec5 "Use local instances with least superclass depth" - - - - - 7d3a055d by Krzysztof Gogolewski at 2022-09-01T01:19:26-04:00 Minor cleanup - Remove mkHeteroCoercionType, sdocImpredicativeTypes, isStateType (unused), isCoVar_maybe (duplicated by getCoVar_maybe) - Replace a few occurrences of voidPrimId with (# #). void# is a deprecated synonym for the unboxed tuple. - Use showSDoc in :show linker. This makes it consistent with the other :show commands - - - - - 31a8989a by Tommy Bidne at 2022-09-01T12:01:20-04:00 Change Ord defaults per CLC proposal Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/24#issuecomment-1233331267 - - - - - 7f527f01 by Matthew Pickering at 2022-09-01T12:01:56-04:00 Fix bootstrap with ghc-9.0 It turns out Solo is a very recent addition to base, so for older GHC versions we just defined it inline here the one place we use it in the compiler. - - - - - d2be80fd by Sebastian Graf at 2022-09-05T23:12:14-04:00 DmdAnal: Don't panic in addCaseBndrDmd (#22039) Rather conservatively return Top. See Note [Untyped demand on case-alternative binders]. I also factored `addCaseBndrDmd` into two separate functions `scrutSubDmd` and `fieldBndrDmds`. Fixes #22039. - - - - - 25f68ace by Ben Gamari at 2022-09-05T23:12:50-04:00 gitlab-ci: Ensure that ghc derivation is in scope Previously the lint-ci job attempted to use cabal-install (specifically `cabal update`) without a GHC in PATH. However, cabal-install-3.8 appears to want GHC, even for `cabal update`. - - - - - f37b621f by sheaf at 2022-09-06T11:51:53+00:00 Update instances.rst, clarifying InstanceSigs Fixes #22103 - - - - - d4f908f7 by Jan Hrček at 2022-09-06T15:36:58-04:00 Fix :add docs in user guide - - - - - 808bb793 by Cheng Shao at 2022-09-06T15:37:35-04:00 ci: remove unused build_make/test_make in ci script - - - - - d0a2efb2 by Eric Lindblad at 2022-09-07T16:42:45-04:00 typo - - - - - fac0098b by Eric Lindblad at 2022-09-07T16:42:45-04:00 typos - - - - - a581186f by Eric Lindblad at 2022-09-07T16:42:45-04:00 whitespace - - - - - 04a738cb by Cheng Shao at 2022-09-07T16:43:22-04:00 CmmToAsm: remove unused ModLocation from NatM_State - - - - - ee1cfaa9 by Krzysztof Gogolewski at 2022-09-07T16:43:58-04:00 Minor SDoc cleanup Change calls to renderWithContext with showSDocOneLine; it's more efficient and explanatory. Remove polyPatSig (unused) - - - - - 7918265d by Krzysztof Gogolewski at 2022-09-07T16:43:58-04:00 Remove Outputable Char instance Use 'text' instead of 'ppr'. Using 'ppr' on the list "hello" rendered as "h,e,l,l,o". - - - - - 77209ab3 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Export liftA2 from Prelude Changes: In order to be warning free and compatible, we hide Applicative(..) from Prelude in a few places and instead import it directly from Control.Applicative. Please see the migration guide at https://github.com/haskell/core-libraries-committee/blob/main/guides/export-lifta2-prelude.md for more details. This means that Applicative is now exported in its entirety from Prelude. Motivation: This change is motivated by a few things: * liftA2 is an often used function, even more so than (<*>) for some people. * When implementing Applicative, the compiler will prompt you for either an implementation of (<*>) or of liftA2, but trying to use the latter ends with an error, without further imports. This could be confusing for newbies. * For teaching, it is often times easier to introduce liftA2 first, as it is a natural generalisation of fmap. * This change seems to have been unanimously and enthusiastically accepted by the CLC members, possibly indicating a lot of love for it. * This change causes very limited breakage, see the linked issue below for an investigation on this. See https://github.com/haskell/core-libraries-committee/issues/50 for the surrounding discussion and more details. - - - - - 442a94e8 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Add changelog entry for liftA2 export from Prelude - - - - - fb968680 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Bump submodule containers to one with liftA2 warnings fixed - - - - - f54ff818 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Bump submodule Cabal to one with liftA2 warnings fixed - - - - - a4b34808 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Isolate some Applicative hidings to GHC.Prelude By reexporting the entirety of Applicative from GHC.Prelude, we can save ourselves some `hiding` and importing of `Applicative` in consumers of GHC.Prelude. This also has the benefit of isolating this type of change to GHC.Prelude, so that people in the future don't have to think about it. - - - - - 9c4ea90c by Cheng Shao at 2022-09-08T17:49:47-04:00 CmmToC: enable 64-bit CallishMachOp on 32-bit targets Normally, the unregisterised builds avoid generating 64-bit CallishMachOp in StgToCmm, so CmmToC doesn't support these. However, there do exist cases where we'd like to invoke cmmToC for other cmm inputs which may contain such CallishMachOps, and it's a rather low effort to add support for these since they only require calling into existing ghc-prim cbits. - - - - - 04062510 by Alexis King at 2022-09-11T11:30:32+02:00 Add native delimited continuations to the RTS This patch implements GHC proposal 313, "Delimited continuation primops", by adding native support for delimited continuations to the GHC RTS. All things considered, the patch is relatively small. It almost exclusively consists of changes to the RTS; the compiler itself is essentially unaffected. The primops come with fairly extensive Haddock documentation, and an overview of the implementation strategy is given in the Notes in rts/Continuation.c. This first stab at the implementation prioritizes simplicity over performance. Most notably, every continuation is always stored as a single, contiguous chunk of stack. If one of these chunks is particularly large, it can result in poor performance, as the current implementation does not attempt to cleverly squeeze a subset of the stack frames into the existing stack: it must fit all at once. If this proves to be a performance issue in practice, a cleverer strategy would be a worthwhile target for future improvements. - - - - - ee471dfb by Cheng Shao at 2022-09-12T07:07:33-04:00 rts: fix missing dirty_MVAR argument in stg_writeIOPortzh - - - - - a5f9c35f by Cheng Shao at 2022-09-12T13:29:05-04:00 ci: enable parallel compression for xz - - - - - 3a815f30 by Ryan Scott at 2022-09-12T13:29:41-04:00 Windows: Always define _UCRT when compiling C code As seen in #22159, this is required to ensure correct behavior when MinGW-w64 headers are in the `C_INCLUDE_PATH`. Fixes #22159. - - - - - 65a0bd69 by sheaf at 2022-09-13T10:27:52-04:00 Add diagnostic codes This MR adds diagnostic codes, assigning unique numeric codes to error and warnings, e.g. error: [GHC-53633] Pattern match is redundant This is achieved as follows: - a type family GhcDiagnosticCode that gives the diagnostic code for each diagnostic constructor, - a type family ConRecursInto that specifies whether to recur into an argument of the constructor to obtain a more fine-grained code (e.g. different error codes for different 'deriving' errors), - generics machinery to generate the value-level function assigning each diagnostic its error code; see Note [Diagnostic codes using generics] in GHC.Types.Error.Codes. The upshot is that, to add a new diagnostic code, contributors only need to modify the two type families mentioned above. All logic relating to diagnostic codes is thus contained to the GHC.Types.Error.Codes module, with no code duplication. This MR also refactors error message datatypes a bit, ensuring we can derive Generic for them, and cleans up the logic around constraint solver reports by splitting up 'TcSolverReportInfo' into separate datatypes (see #20772). Fixes #21684 - - - - - 362cca13 by sheaf at 2022-09-13T10:27:53-04:00 Diagnostic codes: acccept test changes The testsuite output now contains diagnostic codes, so many tests need to be updated at once. We decided it was best to keep the diagnostic codes in the testsuite output, so that contributors don't inadvertently make changes to the diagnostic codes. - - - - - 08f6730c by Adam Gundry at 2022-09-13T10:28:29-04:00 Allow imports to reference multiple fields with the same name (#21625) If a module `M` exports two fields `f` (using DuplicateRecordFields), we can still accept import M (f) import M hiding (f) and treat `f` as referencing both of them. This was accepted in GHC 9.0, but gave rise to an ambiguity error in GHC 9.2. See #21625. This patch also documents this behaviour in the user's guide, and updates the test for #16745 which is now treated differently. - - - - - c14370d7 by Cheng Shao at 2022-09-13T10:29:07-04:00 ci: remove unused appveyor config - - - - - dc6af9ed by Cheng Shao at 2022-09-13T10:29:45-04:00 compiler: remove unused lazy state monad - - - - - 646d15ad by Eric Lindblad at 2022-09-14T03:13:56-04:00 Fix typos This fixes various typos and spelling mistakes in the compiler. Fixes #21891 - - - - - 7d7e71b0 by Matthew Pickering at 2022-09-14T03:14:32-04:00 hadrian: Bump index state This bumps the index state so a build plan can also be found when booting with 9.4. Fixes #22165 - - - - - 98b62871 by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Use a stamp file to record when a package is built in a certain way Before this patch which library ways we had built wasn't recorded directly. So you would run into issues if you build the .conf file with some library ways before switching the library ways which you wanted to build. Now there is one stamp file for each way, so in order to build a specific way you can need that specific stamp file rather than going indirectly via the .conf file. - - - - - b42cedbe by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Inplace/Final package databases There are now two different package databases per stage. An inplace package database contains .conf files which point directly into the build directories. The final package database contains .conf files which point into the installed locations. The inplace .conf files are created before any building happens and have fake ABI hash values. The final .conf files are created after a package finished building and contains the proper ABI has. The motivation for this is to make the dependency structure more fine-grained when building modules. Now a module depends just depends directly on M.o from package p rather than the .conf file depend on the .conf file for package p. So when all of a modules direct dependencies have finished building we can start building it rather than waiting for the whole package to finish. The secondary motivation is that the multi-repl doesn't need to build everything before starting the multi-repl session. We can just configure the inplace package-db and use that in order to start the repl. - - - - - 6515c32b by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Add some more packages to multi-cradle The main improvement here is to pass `-this-unit-id` for executables so that they can be added to the multi-cradle if desired as well as normal library packages. - - - - - e470e91f by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Need builders needed by Cabal Configure in parallel Because of the use of withStaged (which needs the necessary builder) when configuring a package, the builds of stage1:exe:ghc-bin and stage1:exe:ghc-pkg where being linearised when building a specific target like `binary-dist-dir`. Thankfully the fix is quite local, to supply all the `withStaged` arguments together so the needs can be batched together and hence performed in parallel. Fixes #22093 - - - - - c4438347 by Matthew Pickering at 2022-09-14T17:17:04-04:00 Remove stage1:exe:ghc-bin pre-build from CI script CI builds stage1:exe:ghc-bin before the binary-dist target which introduces some quite bad linearisation (see #22093) because we don't build stage1 compiler in parallel with anything. Then when the binary-dist target is started we have to build stage1:exe:ghc-pkg before doing anything. Fixes #22094 - - - - - 71d8db86 by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Add extra implicit dependencies from DeriveLift ghc -M should know that modules which use DeriveLift (or TemplateHaskellQuotes) need TH.Lib.Internal but until it does, we have to add these extra edges manually or the modules will be compiled before TH.Lib.Internal is compiled which leads to a desugarer error. - - - - - 43e574f0 by Greg Steuck at 2022-09-14T17:17:43-04:00 Repair c++ probing on OpenBSD Failure without this change: ``` checking C++ standard library flavour... libc++ checking for linkage against 'c++ c++abi'... failed checking for linkage against 'c++ cxxrt'... failed configure: error: Failed to find C++ standard library ``` - - - - - 534b39ee by Douglas Wilson at 2022-09-14T17:18:21-04:00 libraries: template-haskell: vendor filepath differently Vendoring with ../ in hs-source-dirs prevents upload to hackage. (cherry picked from commit 1446be7586ba70f9136496f9b67f792955447842) - - - - - bdd61cd6 by M Farkas-Dyck at 2022-09-14T22:39:34-04:00 Unbreak Hadrian with Cabal 3.8. - - - - - df04d6ec by Krzysztof Gogolewski at 2022-09-14T22:40:09-04:00 Fix typos - - - - - d6ea8356 by Andreas Klebinger at 2022-09-15T10:12:41+02:00 Tag inference: Fix #21954 by retaining tagsigs of vars in function position. For an expression like: case x of y Con z -> z If we also retain the tag sig for z we can generate code to immediately return it rather than calling out to stg_ap_0_fast. - - - - - 7cce7007 by Andreas Klebinger at 2022-09-15T10:12:42+02:00 Stg.InferTags.Rewrite - Avoid some thunks. - - - - - 88c4cbdb by Cheng Shao at 2022-09-16T13:57:56-04:00 hadrian: enable -fprof-late only for profiling ways - - - - - d7235831 by Cheng Shao at 2022-09-16T13:57:56-04:00 hadrian: add late_ccs flavour transformer - - - - - ce203753 by Cheng Shao at 2022-09-16T13:58:34-04:00 configure: remove unused program checks - - - - - 9b4c1056 by Pierre Le Marre at 2022-09-16T13:59:16-04:00 Update to Unicode 15.0 - - - - - c6e9b89a by Bodigrim at 2022-09-16T13:59:55-04:00 Avoid partial head and tail in ghc-heap; replace with total pattern-matching - - - - - 616afde3 by Cheng Shao at 2022-09-16T14:00:33-04:00 hadrian: relax Cabal upper bound to allow building with Cabal-3.8 A follow up of !8910. - - - - - df35d994 by Alexis King at 2022-09-16T14:01:11-04:00 Add links to the continuations haddocks in the docs for each primop fixes #22176 - - - - - 383f7549 by Matthew Pickering at 2022-09-16T21:42:10-04:00 -Wunused-pattern-binds: Recurse into patterns to check whether there's a splice See the examples in #22057 which show we have to traverse deeply into a pattern to determine whether it contains a splice or not. The original implementation pointed this out but deemed this very shallow traversal "too expensive". Fixes #22057 I also fixed an oversight in !7821 which meant we lost a warning which was present in 9.2.2. Fixes #22067 - - - - - 5031bf49 by sheaf at 2022-09-16T21:42:49-04:00 Hadrian: Don't try to build terminfo on Windows Commit b42cedbe introduced a dependency on terminfo on Windows, but that package isn't available on Windows. - - - - - c9afe221 by M Farkas-Dyck at 2022-09-17T06:44:47-04:00 Clean up some. In particular: • Delete some dead code, largely under `GHC.Utils`. • Clean up a few definitions in `GHC.Utils.(Misc, Monad)`. • Clean up `GHC.Types.SrcLoc`. • Derive stock `Functor, Foldable, Traversable` for more types. • Derive more instances for newtypes. Bump haddock submodule. - - - - - 85431ac3 by Cheng Shao at 2022-09-17T06:45:25-04:00 driver: pass original Cmm filename in ModLocation When compiling Cmm, the ml_hs_file field is used to indicate Cmm filename when later generating DWARF information. We should pass the original filename here, otherwise for preprocessed Cmm files, the filename will be a temporary filename which is confusing. - - - - - 63aa0069 by Cheng Shao at 2022-09-17T06:46:04-04:00 rts: remove legacy logging cabal flag - - - - - bd0f4184 by Cheng Shao at 2022-09-17T06:46:04-04:00 rts: make threaded ways optional For certain targets (e.g. wasm32-wasi), the threaded rts is known not to work. This patch adds a "threaded" cabal flag to rts to make threaded rts ways optional. Hadrian enables this flag iff the flavour rtsWays contains threaded ways. - - - - - 8a666ad2 by Ryan Scott at 2022-09-18T08:00:44-04:00 DeriveFunctor: Check for last type variables using dataConUnivTyVars Previously, derived instances of `Functor` (as well as the related classes `Foldable`, `Traversable`, and `Generic1`) would determine which constraints to infer by checking for fields that contain the last type variable. The problem was that this last type variable was taken from `tyConTyVars`. For GADTs, the type variables in each data constructor are _not_ the same type variables as in `tyConTyVars`, leading to #22167. This fixes the issue by instead checking for the last type variable using `dataConUnivTyVars`. (This is very similar in spirit to the fix for #21185, which also replaced an errant use of `tyConTyVars` with type variables from each data constructor.) Fixes #22167. - - - - - 78037167 by Vladislav Zavialov at 2022-09-18T08:01:20-04:00 Lexer: pass updated buffer to actions (#22201) In the lexer, predicates have the following type: { ... } :: user -- predicate state -> AlexInput -- input stream before the token -> Int -- length of the token -> AlexInput -- input stream after the token -> Bool -- True <=> accept the token This is documented in the Alex manual. There is access to the input stream both before and after the token. But when the time comes to construct the token, GHC passes only the initial string buffer to the lexer action. This patch fixes it: - type Action = PsSpan -> StringBuffer -> Int -> P (PsLocated Token) + type Action = PsSpan -> StringBuffer -> Int -> StringBuffer -> P (PsLocated Token) Now lexer actions have access to the string buffer both before and after the token, just like the predicates. It's just a matter of passing an additional function parameter throughout the lexer. - - - - - 75746594 by Vladislav Zavialov at 2022-09-18T08:01:20-04:00 Lexer: define varsym without predicates (#22201) Before this patch, the varsym lexing rules were defined as follows: <0> { @varsym / { precededByClosingToken `alexAndPred` followedByOpeningToken } { varsym_tight_infix } @varsym / { followedByOpeningToken } { varsym_prefix } @varsym / { precededByClosingToken } { varsym_suffix } @varsym { varsym_loose_infix } } Unfortunately, this meant that the predicates 'precededByClosingToken' and 'followedByOpeningToken' were recomputed several times before we could figure out the whitespace context. With this patch, we check for whitespace context directly in the lexer action: <0> { @varsym { with_op_ws varsym } } The checking for opening/closing tokens happens in 'with_op_ws' now, which is part of the lexer action rather than the lexer predicate. - - - - - c1f81b38 by M Farkas-Dyck at 2022-09-19T09:07:05-04:00 Scrub partiality about `NewOrData`. Rather than a list of constructors and a `NewOrData` flag, we define `data DataDefnCons a = NewTypeCon a | DataTypeCons [a]`, which enforces a newtype to have exactly one constructor. Closes #22070. Bump haddock submodule. - - - - - 1e1ed8c5 by Cheng Shao at 2022-09-19T09:07:43-04:00 CmmToC: emit __builtin_unreachable() after noreturn ccalls Emit a __builtin_unreachable() call after a foreign call marked as CmmNeverReturns. This is crucial to generate correctly typed code for wasm; as for other archs, this is also beneficial for the C compiler optimizations. - - - - - 19f45a25 by Jan Hrček at 2022-09-20T03:49:29-04:00 Document :unadd GHCi command in user guide - - - - - 545ff490 by sheaf at 2022-09-20T03:50:06-04:00 Hadrian: merge archives even in stage 0 We now always merge .a archives when ar supports -L. This change is necessary in order to bootstrap GHC using GHC 9.4 on Windows, as nested archives aren't supported. Not doing so triggered bug #21990 when trying to use the Win32 package, with errors such as: Not a x86_64 PE+ file. Unknown COFF 4 type in getHeaderInfo. ld.lld: error: undefined symbol: Win32zm2zi12zi0zi0_SystemziWin32ziConsoleziCtrlHandler_withConsoleCtrlHandler1_info We have to be careful about which ar is meant: in stage 0, the check should be done on the system ar (system-ar in system.config). - - - - - 59fe128c by Vladislav Zavialov at 2022-09-20T03:50:42-04:00 Fix -Woperator-whitespace for consym (part of #19372) Due to an oversight, the initial specification and implementation of -Woperator-whitespace focused on varsym exclusively and completely ignored consym. This meant that expressions such as "x+ y" would produce a warning, while "x:+ y" would not. The specification was corrected in ghc-proposals pull request #404, and this patch updates the implementation accordingly. Regression test included. - - - - - c4c2cca0 by John Ericson at 2022-09-20T13:11:49-04:00 Add `Eq` and `Ord` instances for `Generically1` These are needed so the subsequent commit overhauling the `*1` classes type-checks. - - - - - 7beb356e by John Ericson at 2022-09-20T13:11:50-04:00 Relax instances for Functor combinators; put superclass on Class1 and Class2 to make non-breaking This change is approved by the Core Libraries commitee in https://github.com/haskell/core-libraries-committee/issues/10 The first change makes the `Eq`, `Ord`, `Show`, and `Read` instances for `Sum`, `Product`, and `Compose` match those for `:+:`, `:*:`, and `:.:`. These have the proper flexible contexts that are exactly what the instance needs: For example, instead of ```haskell instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where (==) = eq1 ``` we do ```haskell deriving instance Eq (f (g a)) => Eq (Compose f g a) ``` But, that change alone is rather breaking, because until now `Eq (f a)` and `Eq1 f` (and respectively the other classes and their `*1` equivalents too) are *incomparable* constraints. This has always been an annoyance of working with the `*1` classes, and now it would rear it's head one last time as an pesky migration. Instead, we give the `*1` classes superclasses, like so: ```haskell (forall a. Eq a => Eq (f a)) => Eq1 f ``` along with some laws that canonicity is preserved, like: ```haskell liftEq (==) = (==) ``` and likewise for `*2` classes: ```haskell (forall a. Eq a => Eq1 (f a)) => Eq2 f ``` and laws: ```haskell liftEq2 (==) = liftEq1 ``` The `*1` classes also have default methods using the `*2` classes where possible. What this means, as explained in the docs, is that `*1` classes really are generations of the regular classes, indicating that the methods can be split into a canonical lifting combined with a canonical inner, with the super class "witnessing" the laws[1] in a fashion. Circling back to the pragmatics of migrating, note that the superclass means evidence for the old `Sum`, `Product`, and `Compose` instances is (more than) sufficient, so breakage is less likely --- as long no instances are "missing", existing polymorphic code will continue to work. Breakage can occur when a datatype implements the `*1` class but not the corresponding regular class, but this is almost certainly an oversight. For example, containers made that mistake for `Tree` and `Ord`, which I fixed in https://github.com/haskell/containers/pull/761, but fixing the issue by adding `Ord1` was extremely *un*controversial. `Generically1` was also missing `Eq`, `Ord`, `Read,` and `Show` instances. It is unlikely this would have been caught without implementing this change. ----- [1]: In fact, someday, when the laws are part of the language and not only documentation, we might be able to drop the superclass field of the dictionary by using the laws to recover the superclass in an instance-agnostic manner, e.g. with a *non*-overloaded function with type: ```haskell DictEq1 f -> DictEq a -> DictEq (f a) ``` But I don't wish to get into optomizations now, just demonstrate the close relationship between the law and the superclass. Bump haddock submodule because of test output changing. - - - - - 6a8c6b5e by Tom Ellis at 2022-09-20T13:12:27-04:00 Add notes to ghc-prim Haddocks that users should not import it - - - - - ee9d0f5c by matoro at 2022-09-20T13:13:06-04:00 docs: clarify that LLVM codegen is not available in unregisterised mode The current docs are misleading and suggest that it is possible to use LLVM codegen from an unregisterised build. This is not the case; attempting to pass `-fllvm` to an unregisterised build warns: ``` when making flags consistent: warning: Target platform uses unregisterised ABI, so compiling via C ``` and uses the C codegen anyway. - - - - - 854224ed by Nicolas Trangez at 2022-09-20T20:14:29-04:00 rts: remove copy-paste error from `cabal.rts.in` This was, likely accidentally, introduced in 4bf542bf1c. See: 4bf542bf1cdf2fa468457fc0af21333478293476 - - - - - c8ae3add by Matthew Pickering at 2022-09-20T20:15:04-04:00 hadrian: Add extra_dependencies edges for all different ways The hack to add extra dependencies needed by DeriveLift extension missed the cases for profiles and dynamic ways. For the profiled way this leads to errors like: ``` GHC error in desugarer lookup in Data.IntSet.Internal: Failed to load interface for ‘Language.Haskell.TH.Lib.Internal’ Perhaps you haven't installed the profiling libraries for package ‘template-haskell’? Use -v (or `:set -v` in ghci) to see a list of the files searched for. ghc: panic! (the 'impossible' happened) GHC version 9.5.20220916: initDs ``` Therefore the fix is to add these extra edges in. Fixes #22197 - - - - - a971657d by Mon Aaraj at 2022-09-21T06:41:24+03:00 users-guide: fix incorrect ghcappdata folder for unix and windows - - - - - 06ccad0d by sheaf at 2022-09-21T08:28:49-04:00 Don't use isUnliftedType in isTagged The function GHC.Stg.InferTags.Rewrite.isTagged can be given the Id of a join point, which might be representation polymorphic. This would cause the call to isUnliftedType to crash. It's better to use typeLevity_maybe instead. Fixes #22212 - - - - - c0ba775d by Teo Camarasu at 2022-09-21T14:30:37-04:00 Add fragmentation statistic to GHC.Stats Implements #21537 - - - - - 2463df2f by Torsten Schmits at 2022-09-21T14:31:24-04:00 Rename Solo[constructor] to MkSolo Part of proposal 475 (https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0475-tuple-syntax.rst) Moves all tuples to GHC.Tuple.Prim Updates ghc-prim version (and bumps bounds in dependents) updates haddock submodule updates deepseq submodule updates text submodule - - - - - 9034fada by Matthew Pickering at 2022-09-22T09:25:29-04:00 Update filepath to filepath-1.4.100.0 Updates submodule * Always rely on vendored filepath * filepath must be built as stage0 dependency because it uses template-haskell. Towards #22098 - - - - - 615e2278 by Krzysztof Gogolewski at 2022-09-22T09:26:05-04:00 Minor refactor around Outputable * Replace 'text . show' and 'ppr' with 'int'. * Remove Outputable.hs-boot, no longer needed * Use pprWithCommas * Factor out instructions in AArch64 codegen - - - - - aeafdba5 by Sebastian Graf at 2022-09-27T15:14:54+02:00 Demand: Clear distinction between Call SubDmd and eval Dmd (#21717) In #21717 we saw a reportedly unsound strictness signature due to an unsound definition of plusSubDmd on Calls. This patch contains a description and the fix to the unsoundness as outlined in `Note [Call SubDemand vs. evaluation Demand]`. This fix means we also get rid of the special handling of `-fpedantic-bottoms` in eta-reduction. Thanks to less strict and actually sound strictness results, we will no longer eta-reduce the problematic cases in the first place, even without `-fpedantic-bottoms`. So fixing the unsoundness also makes our eta-reduction code simpler with less hacks to explain. But there is another, more unfortunate side-effect: We *unfix* #21085, but fortunately we have a new fix ready: See `Note [mkCall and plusSubDmd]`. There's another change: I decided to make `Note [SubDemand denotes at least one evaluation]` a lot simpler by using `plusSubDmd` (instead of `lubPlusSubDmd`) even if both argument demands are lazy. That leads to less precise results, but in turn rids ourselves from the need for 4 different `OpMode`s and the complication of `Note [Manual specialisation of lub*Dmd/plus*Dmd]`. The result is simpler code that is in line with the paper draft on Demand Analysis. I left the abandoned idea in `Note [Unrealised opportunity in plusDmd]` for posterity. The fallout in terms of regressions is negligible, as the testsuite and NoFib shows. ``` Program Allocs Instrs -------------------------------------------------------------------------------- hidden +0.2% -0.2% linear -0.0% -0.7% -------------------------------------------------------------------------------- Min -0.0% -0.7% Max +0.2% +0.0% Geometric Mean +0.0% -0.0% ``` Fixes #21717. - - - - - 9b1595c8 by Ross Paterson at 2022-09-27T14:12:01-04:00 implement proposal 106 (Define Kinds Without Promotion) (fixes #6024) includes corresponding changes to haddock submodule - - - - - c2d73cb4 by Andreas Klebinger at 2022-09-28T15:07:30-04:00 Apply some tricks to speed up core lint. Below are the noteworthy changes and if given their impact on compiler allocations for a type heavy module: * Use the oneShot trick on LintM * Use a unboxed tuple for the result of LintM: ~6% reduction * Avoid a thunk for the result of typeKind in lintType: ~5% reduction * lint_app: Don't allocate the error msg in the hot code path: ~4% reduction * lint_app: Eagerly force the in scope set: ~4% * nonDetCmpType: Try to short cut using reallyUnsafePtrEquality#: ~2% * lintM: Use a unboxed maybe for the `a` result: ~12% * lint_app: make go_app tail recursive to avoid allocating the go function as heap closure: ~7% * expandSynTyCon_maybe: Use a specialized data type For a less type heavy module like nofib/spectral/simple compiled with -O -dcore-lint allocations went down by ~24% and compile time by ~9%. ------------------------- Metric Decrease: T1969 ------------------------- - - - - - b74b6191 by sheaf at 2022-09-28T15:08:10-04:00 matchLocalInst: do domination analysis When multiple Given quantified constraints match a Wanted, and there is a quantified constraint that dominates all others, we now pick it to solve the Wanted. See Note [Use only the best matching quantified constraint]. For example: [G] d1: forall a b. ( Eq a, Num b, C a b ) => D a b [G] d2: forall a . C a Int => D a Int [W] {w}: D a Int When solving the Wanted, we find that both Givens match, but we pick the second, because it has a weaker precondition, C a Int, compared to (Eq a, Num Int, C a Int). We thus say that d2 dominates d1; see Note [When does a quantified instance dominate another?]. This domination test is done purely in terms of superclass expansion, in the function GHC.Tc.Solver.Interact.impliedBySCs. We don't attempt to do a full round of constraint solving; this simple check suffices for now. Fixes #22216 and #22223 - - - - - 2a53ac18 by Simon Peyton Jones at 2022-09-28T17:49:09-04:00 Improve aggressive specialisation This patch fixes #21286, by not unboxing dictionaries in worker/wrapper (ever). The main payload is tiny: * In `GHC.Core.Opt.DmdAnal.finaliseArgBoxities`, do not unbox dictionaries in `get_dmd`. See Note [Do not unbox class dictionaries] in that module * I also found that imported wrappers were being fruitlessly specialised, so I fixed that too, in canSpecImport. See Note [Specialising imported functions] point (2). In doing due diligence in the testsuite I fixed a number of other things: * Improve Note [Specialising unfoldings] in GHC.Core.Unfold.Make, and Note [Inline specialisations] in GHC.Core.Opt.Specialise, and remove duplication between the two. The new Note describes how we specialise functions with an INLINABLE pragma. And simplify the defn of `spec_unf` in `GHC.Core.Opt.Specialise.specCalls`. * Improve Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap. And (critially) make an actual change which is to propagate the user-written pragma from the original function to the wrapper; see `mkStrWrapperInlinePrag`. * Write new Note [Specialising imported functions] in GHC.Core.Opt.Specialise All this has a big effect on some compile times. This is compiler/perf, showing only changes over 1%: Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -50.2% GOOD ManyConstructors(normal) +1.0% MultiLayerModulesTH_OneShot(normal) +2.6% PmSeriesG(normal) -1.1% T10547(normal) -1.2% T11195(normal) -1.2% T11276(normal) -1.0% T11303b(normal) -1.6% T11545(normal) -1.4% T11822(normal) -1.3% T12150(optasm) -1.0% T12234(optasm) -1.2% T13056(optasm) -9.3% GOOD T13253(normal) -3.8% GOOD T15164(normal) -3.6% GOOD T16190(normal) -2.1% T16577(normal) -2.8% GOOD T16875(normal) -1.6% T17836(normal) +2.2% T17977b(normal) -1.0% T18223(normal) -33.3% GOOD T18282(normal) -3.4% GOOD T18304(normal) -1.4% T18698a(normal) -1.4% GOOD T18698b(normal) -1.3% GOOD T19695(normal) -2.5% GOOD T5837(normal) -2.3% T9630(normal) -33.0% GOOD WWRec(normal) -9.7% GOOD hard_hole_fits(normal) -2.1% GOOD hie002(normal) +1.6% geo. mean -2.2% minimum -50.2% maximum +2.6% I diligently investigated some of the big drops. * Caused by not doing w/w for dictionaries: T13056, T15164, WWRec, T18223 * Caused by not fruitlessly specialising wrappers LargeRecord, T9630 For runtimes, here is perf/should+_run: Metrics: runtime/bytes allocated -------------------------------- T12990(normal) -3.8% T5205(normal) -1.3% T9203(normal) -10.7% GOOD haddock.Cabal(normal) +0.1% haddock.base(normal) -1.1% haddock.compiler(normal) -0.3% lazy-bs-alloc(normal) -0.2% ------------------------------------------ geo. mean -0.3% minimum -10.7% maximum +0.1% I did not investigate exactly what happens in T9203. Nofib is a wash: +-------------------------------++--+-----------+-----------+ | || | tsv (rel) | std. err. | +===============================++==+===========+===========+ | real/anna || | -0.13% | 0.0% | | real/fem || | +0.13% | 0.0% | | real/fulsom || | -0.16% | 0.0% | | real/lift || | -1.55% | 0.0% | | real/reptile || | -0.11% | 0.0% | | real/smallpt || | +0.51% | 0.0% | | spectral/constraints || | +0.20% | 0.0% | | spectral/dom-lt || | +1.80% | 0.0% | | spectral/expert || | +0.33% | 0.0% | +===============================++==+===========+===========+ | geom mean || | | | +-------------------------------++--+-----------+-----------+ I spent quite some time investigating dom-lt, but it's pretty complicated. See my note on !7847. Conclusion: it's just a delicate inlining interaction, and we have plenty of those. Metric Decrease: LargeRecord T13056 T13253 T15164 T16577 T18223 T18282 T18698a T18698b T19695 T9630 WWRec hard_hole_fits T9203 - - - - - addeefc0 by Simon Peyton Jones at 2022-09-28T17:49:09-04:00 Refactor UnfoldingSource and IfaceUnfolding I finally got tired of the way that IfaceUnfolding reflected a previous structure of unfoldings, not the current one. This MR refactors UnfoldingSource and IfaceUnfolding to be simpler and more consistent. It's largely just a refactor, but in UnfoldingSource (which moves to GHC.Types.Basic, since it is now used in IfaceSyn too), I distinguish between /user-specified/ and /system-generated/ stable unfoldings. data UnfoldingSource = VanillaSrc | StableUserSrc -- From a user-specified pragma | StableSystemSrc -- From a system-generated unfolding | CompulsorySrc This has a minor effect in CSE (see the use of isisStableUserUnfolding in GHC.Core.Opt.CSE), which I tripped over when working on specialisation, but it seems like a Good Thing to know anyway. - - - - - 7be6f9a4 by Simon Peyton Jones at 2022-09-28T17:49:09-04:00 INLINE/INLINEABLE pragmas in Foreign.Marshal.Array Foreign.Marshal.Array contains many small functions, all of which are overloaded, and which are critical for performance. Yet none of them had pragmas, so it was a fluke whether or not they got inlined. This patch makes them all either INLINE (small ones) or INLINEABLE and hence specialisable (larger ones). See Note [Specialising array operations] in that module. - - - - - b0c89dfa by Jade Lovelace at 2022-09-28T17:49:49-04:00 Export OnOff from GHC.Driver.Session I was working on fixing an issue where HLS was trying to pass its DynFlags to HLint, but didn't pass any of the disabled language extensions, which HLint would then assume are on because of their default values. Currently it's not possible to get any of the "No" flags because the `DynFlags.extensions` field can't really be used since it is [OnOff Extension] and OnOff is not exported. So let's export it. - - - - - 2f050687 by Bodigrim at 2022-09-28T17:50:28-04:00 Avoid Data.List.group; prefer Data.List.NonEmpty.group This allows to avoid further partiality, e. g., map head . group is replaced by map NE.head . NE.group, and there are less panic calls. - - - - - bc0020fa by M Farkas-Dyck at 2022-09-28T22:51:59-04:00 Clean up `findWiredInUnit`. In particular, avoid `head`. - - - - - 6a2eec98 by Bodigrim at 2022-09-28T22:52:38-04:00 Eliminate headFS, use unconsFS instead A small step towards #22185 to avoid partial functions + safe implementation of `startsWithUnderscore`. - - - - - 5a535172 by Sebastian Graf at 2022-09-29T17:04:20+02:00 Demand: Format Call SubDemands `Cn(sd)` as `C(n,sd)` (#22231) Justification in #22231. Short form: In a demand like `1C1(C1(L))` it was too easy to confuse which `1` belongs to which `C`. Now that should be more obvious. Fixes #22231 - - - - - ea0083bf by Bryan Richter at 2022-09-29T15:48:38-04:00 Revert "ci: enable parallel compression for xz" Combined wxth XZ_OPT=9, this blew the memory capacity of CI runners. This reverts commit a5f9c35f5831ef5108e87813a96eac62803852ab. - - - - - f5e8f493 by Sebastian Graf at 2022-09-30T18:42:13+02:00 Boxity: Don't update Boxity unless worker/wrapper follows (#21754) A small refactoring in our Core Opt pipeline and some new functions for transfering argument boxities from one signature to another to facilitate `Note [Don't change boxity without worker/wrapper]`. Fixes #21754. - - - - - 4baf7b1c by M Farkas-Dyck at 2022-09-30T17:45:47-04:00 Scrub various partiality involving empty lists. Avoids some uses of `head` and `tail`, and some panics when an argument is null. - - - - - 95ead839 by Alexis King at 2022-10-01T00:37:43-04:00 Fix a bug in continuation capture across multiple stack chunks - - - - - 22096652 by Bodigrim at 2022-10-01T00:38:22-04:00 Enforce internal invariant of OrdList and fix bugs in viewCons / viewSnoc `viewCons` used to ignore `Many` constructor completely, returning `VNothing`. `viewSnoc` violated internal invariant of `Many` being a non-empty list. - - - - - 48ab9ca5 by Nicolas Trangez at 2022-10-04T20:34:10-04:00 chore: extend `.editorconfig` for C files - - - - - b8df5c72 by Brandon Chinn at 2022-10-04T20:34:46-04:00 Fix docs for pattern synonyms - - - - - 463ffe02 by Oleg Grenrus at 2022-10-04T20:35:24-04:00 Use sameByteArray# in sameByteArray - - - - - fbe1e86e by Pierre Le Marre at 2022-10-05T15:58:43+02:00 Minor fixes following Unicode 15.0.0 update - Fix changelog for Unicode 15.0.0 - Fix the checksums of the downloaded Unicode files, in base's tool: "ucd2haskell". - - - - - 8a31d02e by Cheng Shao at 2022-10-05T20:40:41-04:00 rts: don't enforce aligned((8)) on 32-bit targets We simply need to align to the word size for pointer tagging to work. On 32-bit targets, aligned((8)) is wasteful. - - - - - 532de368 by Ryan Scott at 2022-10-06T07:45:46-04:00 Export symbolSing, SSymbol, and friends (CLC#85) This implements this Core Libraries Proposal: https://github.com/haskell/core-libraries-committee/issues/85 In particular, it: 1. Exposes the `symbolSing` method of `KnownSymbol`, 2. Exports the abstract `SSymbol` type used in `symbolSing`, and 3. Defines an API for interacting with `SSymbol`. This also makes corresponding changes for `natSing`/`KnownNat`/`SNat` and `charSing`/`KnownChar`/`SChar`. This fixes #15183 and addresses part (2) of #21568. - - - - - d83a92e6 by sheaf at 2022-10-07T07:36:30-04:00 Remove mention of make from README.md - - - - - 945e8e49 by Bodigrim at 2022-10-10T17:13:31-04:00 Add a newline before since pragma in Data.Array.Byte - - - - - 44fcdb04 by Vladislav Zavialov at 2022-10-10T17:14:06-04:00 Parser/PostProcess: rename failOp* functions There are three functions named failOp* in the parser: failOpNotEnabledImportQualifiedPost failOpImportQualifiedTwice failOpFewArgs Only the last one has anything to do with operators. The other two were named this way either by mistake or due to a misunderstanding of what "op" stands for. This small patch corrects this. - - - - - 96d32ff2 by Simon Peyton Jones at 2022-10-10T22:30:21+01:00 Make rewrite rules "win" over inlining If a rewrite rule and a rewrite rule compete in the simplifier, this patch makes sure that the rewrite rule "win". That is, in general a bit fragile, but it's a huge help when making specialisation work reliably, as #21851 and #22097 showed. The change is fairly straightforwad, and documented in Note [Rewrite rules and inlining] in GHC.Core.Opt.Simplify.Iteration. Compile-times change, up and down a bit -- in some cases because we get better specialisation. But the payoff (more reliable specialisation) is large. Metrics: compile_time/bytes allocated ----------------------------------------------- T10421(normal) +3.7% BAD T10421a(normal) +5.5% T13253(normal) +1.3% T14052(ghci) +1.8% T15304(normal) -1.4% T16577(normal) +3.1% BAD T17516(normal) +2.3% T17836(normal) -1.9% T18223(normal) -1.8% T8095(normal) -1.3% T9961(normal) +2.5% BAD geo. mean +0.0% minimum -1.9% maximum +5.5% Nofib results are (bytes allocated) +-------------------------------++----------+ | ||tsv (rel) | +===============================++==========+ | imaginary/paraffins || +0.27% | | imaginary/rfib || -0.04% | | real/anna || +0.02% | | real/fem || -0.04% | | real/fluid || +1.68% | | real/gamteb || -0.34% | | real/gg || +1.54% | | real/hidden || -0.01% | | real/hpg || -0.03% | | real/infer || -0.03% | | real/prolog || +0.02% | | real/veritas || -0.47% | | shootout/fannkuch-redux || -0.03% | | shootout/k-nucleotide || -0.02% | | shootout/n-body || -0.06% | | shootout/spectral-norm || -0.01% | | spectral/cryptarithm2 || +1.25% | | spectral/fibheaps || +18.33% | | spectral/last-piece || -0.34% | +===============================++==========+ | geom mean || +0.17% | There are extensive notes in !8897 about the regressions. Briefly * fibheaps: there was a very delicately balanced inlining that tipped over the wrong way after this change. * cryptarithm2 and paraffins are caused by #22274, which is a separate issue really. (I.e. the right fix is *not* to make inlining "win" over rules.) So I'm accepting these changes Metric Increase: T10421 T16577 T9961 - - - - - ed4b5885 by Joachim Breitner at 2022-10-10T23:16:11-04:00 Utils.JSON: do not escapeJsonString in ToJson String instance as `escapeJsonString` is used in `renderJSON`, so the `JSString` constructor is meant to carry the unescaped string. - - - - - fbb88740 by Matthew Pickering at 2022-10-11T12:48:45-04:00 Tidy implicit binds We want to put implicit binds into fat interface files, so the easiest thing to do seems to be to treat them uniformly with other binders. - - - - - e058b138 by Matthew Pickering at 2022-10-11T12:48:45-04:00 Interface Files with Core Definitions This commit adds three new flags * -fwrite-if-simplified-core: Writes the whole core program into an interface file * -fbyte-code-and-object-code: Generate both byte code and object code when compiling a file * -fprefer-byte-code: Prefer to use byte-code if it's available when running TH splices. The goal for including the core bindings in an interface file is to be able to restart the compiler pipeline at the point just after simplification and before code generation. Once compilation is restarted then code can be created for the byte code backend. This can significantly speed up start-times for projects in GHCi. HLS already implements its own version of these extended interface files for this reason. Preferring to use byte-code means that we can avoid some potentially expensive code generation steps (see #21700) * Producing object code is much slower than producing bytecode, and normally you need to compile with `-dynamic-too` to produce code in the static and dynamic way, the dynamic way just for Template Haskell execution when using a dynamically linked compiler. * Linking many large object files, which happens once per splice, can be quite expensive compared to linking bytecode. And you can get GHC to compile the necessary byte code so `-fprefer-byte-code` has access to it by using `-fbyte-code-and-object-code`. Fixes #21067 - - - - - 9789ea8e by Matthew Pickering at 2022-10-11T12:48:45-04:00 Teach -fno-code about -fprefer-byte-code This patch teachs the code generation logic of -fno-code about -fprefer-byte-code, so that if we need to generate code for a module which prefers byte code, then we generate byte code rather than object code. We keep track separately which modules need object code and which byte code and then enable the relevant code generation for each. Typically the option will be enabled globally so one of these sets should be empty and we will just turn on byte code or object code generation. We also fix the bug where we would generate code for a module which enables Template Haskell despite the fact it was unecessary. Fixes #22016 - - - - - caced757 by Simon Peyton Jones at 2022-10-11T12:49:21-04:00 Don't keep exit join points so much We were religiously keeping exit join points throughout, which had some bad effects (#21148, #22084). This MR does two things: * Arranges that exit join points are inhibited from inlining only in /one/ Simplifier pass (right after Exitification). See Note [Be selective about not-inlining exit join points] in GHC.Core.Opt.Exitify It's not a big deal, but it shaves 0.1% off compile times. * Inline used-once non-recursive join points very aggressively Given join j x = rhs in joinrec k y = ....j x.... where this is the only occurrence of `j`, we want to inline `j`. (Unless sm_keep_exits is on.) See Note [Inline used-once non-recursive join points] in GHC.Core.Opt.Simplify.Utils This is just a tidy-up really. It doesn't change allocation, but getting rid of a binding is always good. Very effect on nofib -- some up and down. - - - - - 284cf387 by Simon Peyton Jones at 2022-10-11T12:49:21-04:00 Make SpecConstr bale out less often When doing performance debugging on #22084 / !8901, I found that the algorithm in SpecConstr.decreaseSpecCount was so aggressive that if there were /more/ specialisations available for an outer function, that could more or less kill off specialisation for an /inner/ function. (An example was in nofib/spectral/fibheaps.) This patch makes it a bit more aggressive, by dividing by 2, rather than by the number of outer specialisations. This makes the program bigger, temporarily: T19695(normal) ghc/alloc +11.3% BAD because we get more specialisation. But lots of other programs compile a bit faster and the geometric mean in perf/compiler is 0.0%. Metric Increase: T19695 - - - - - 66af1399 by Cheng Shao at 2022-10-11T12:49:59-04:00 CmmToC: emit explicit tail calls when the C compiler supports it Clang 13+ supports annotating a return statement using the musttail attribute, which guarantees that it lowers to a tail call if compilation succeeds. This patch takes advantage of that feature for the unregisterised code generator. The configure script tests availability of the musttail attribute, if it's available, the Cmm tail calls will become C tail calls that avoids the mini interpreter trampoline overhead. Nothing is affected if the musttail attribute is not supported. Clang documentation: https://clang.llvm.org/docs/AttributeReference.html#musttail - - - - - 7f0decd5 by Matthew Pickering at 2022-10-11T12:50:40-04:00 Don't include BufPos in interface files Ticket #22162 pointed out that the build directory was leaking into the ABI hash of a module because the BufPos depended on the location of the build tree. BufPos is only used in GHC.Parser.PostProcess.Haddock, and the information doesn't need to be propagated outside the context of a module. Fixes #22162 - - - - - dce9f320 by Cheng Shao at 2022-10-11T12:51:19-04:00 CLabel: fix isInfoTableLabel isInfoTableLabel does not take Cmm info table into account. This patch is required for data section layout of wasm32 NCG to work. - - - - - da679f2e by Bodigrim at 2022-10-11T18:02:59-04:00 Extend documentation for Data.List, mostly wrt infinite lists - - - - - 9c099387 by jwaldmann at 2022-10-11T18:02:59-04:00 Expand comment for Data.List.permutations - - - - - d3863cb7 by Bodigrim at 2022-10-11T18:03:37-04:00 ByteArray# is unlifted, not unboxed - - - - - f6260e8b by Ben Gamari at 2022-10-11T23:45:10-04:00 rts: Add missing declaration of stg_noDuplicate - - - - - 69ccec2c by Ben Gamari at 2022-10-11T23:45:10-04:00 base: Move CString, CStringLen to GHC.Foreign - - - - - f6e8feb4 by Ben Gamari at 2022-10-11T23:45:10-04:00 base: Move IPE helpers to GHC.InfoProv - - - - - 866c736e by Ben Gamari at 2022-10-11T23:45:10-04:00 rts: Refactor IPE tracing support - - - - - 6b0d2022 by Ben Gamari at 2022-10-11T23:45:10-04:00 Refactor IPE initialization Here we refactor the representation of info table provenance information in object code to significantly reduce its size and link-time impact. Specifically, we deduplicate strings and represent them as 32-bit offsets into a common string table. In addition, we rework the registration logic to eliminate allocation from the registration path, which is run from a static initializer where things like allocation are technically undefined behavior (although it did previously seem to work). For similar reasons we eliminate lock usage from registration path, instead relying on atomic CAS. Closes #22077. - - - - - 9b572d54 by Ben Gamari at 2022-10-11T23:45:10-04:00 Separate IPE source file from span The source file name can very often be shared across many IPE entries whereas the source coordinates are generally unique. Separate the two to exploit sharing of the former. - - - - - 27978ceb by Krzysztof Gogolewski at 2022-10-11T23:45:46-04:00 Make Cmm Lint messages use dump style Lint errors indicate an internal error in GHC, so it makes sense to use it instead of the user style. This is consistent with Core Lint and STG Lint: https://gitlab.haskell.org/ghc/ghc/-/blob/22096652/compiler/GHC/Core/Lint.hs#L429 https://gitlab.haskell.org/ghc/ghc/-/blob/22096652/compiler/GHC/Stg/Lint.hs#L144 Fixes #22218. - - - - - 64a390d9 by Bryan Richter at 2022-10-12T09:52:51+03:00 Mark T7919 as fragile On x86_64-linux, T7919 timed out ~30 times during July 2022. And again ~30 times in September 2022. - - - - - 481467a5 by Ben Gamari at 2022-10-12T08:08:37-04:00 rts: Don't hint inlining of appendToRunQueue These hints have resulted in compile-time warnings due to failed inlinings for quite some time. Moreover, it's quite unlikely that inlining them is all that beneficial given that they are rather sizeable functions. Resolves #22280. - - - - - 81915089 by Curran McConnell at 2022-10-12T16:32:26-04:00 remove name shadowing - - - - - 626652f7 by Tamar Christina at 2022-10-12T16:33:13-04:00 winio: do not re-translate input when handle is uncooked - - - - - 5172789a by Charles Taylor at 2022-10-12T16:33:57-04:00 Unrestricted OverloadedLabels (#11671) Implements GHC proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0170-unrestricted-overloadedlabels.rst - - - - - ce293908 by Andreas Klebinger at 2022-10-13T05:58:19-04:00 Add a perf test for the generics code pattern from #21839. This code showed a strong shift between compile time (got worse) and run time (got a lot better) recently which is perfectly acceptable. However it wasn't clear why the compile time regression was happening initially so I'm adding this test to make it easier to track such changes in the future. - - - - - 78ab7afe by Ben Gamari at 2022-10-13T05:58:56-04:00 rts/linker: Consolidate initializer/finalizer handling Here we extend our treatment of initializer/finalizer priorities to include ELF and in so doing refactor things to share the implementation with PEi386. As well, I fix a subtle misconception of the ordering behavior for `.ctors`. Fixes #21847. - - - - - 44692713 by Ben Gamari at 2022-10-13T05:58:56-04:00 rts/linker: Add support for .fini sections - - - - - beebf546 by Simon Hengel at 2022-10-13T05:59:37-04:00 Update phases.rst (the name of the original source file is $1, not $2) - - - - - eda6c05e by Finley McIlwaine at 2022-10-13T06:00:17-04:00 Clearer error msg for newtype GADTs with defaulted kind When a newtype introduces GADT eq_specs due to a defaulted RuntimeRep, we detect this and print the error message with explicit kinds. This also refactors newtype type checking to use the new diagnostic infra. Fixes #21447 - - - - - 43ab435a by Pierre Le Marre at 2022-10-14T07:45:43-04:00 Add standard Unicode case predicates isUpperCase and isLowerCase. These predicates use the standard Unicode case properties and are more intuitive than isUpper and isLower. Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/90#issuecomment-1276649403. Fixes #14589 - - - - - aec5a443 by Bodigrim at 2022-10-14T07:46:21-04:00 Add type signatures in where-clause of Data.List.permutations The type of interleave' is very much revealing, otherwise it's extremely tough to decipher. - - - - - ee0deb80 by Ben Gamari at 2022-10-14T18:29:20-04:00 rts: Use pthread_setname_np correctly on Darwin As noted in #22206, pthread_setname_np on Darwin only supports setting the name of the calling thread. Consequently we must introduce a trampoline which first sets the thread name before entering the thread entrypoint. - - - - - 8eff62a4 by Ben Gamari at 2022-10-14T18:29:57-04:00 testsuite: Add test for #22282 This will complement mpickering's more general port of foundation's numerical testsuite, providing a test for the specific case found in #22282. - - - - - 62a55001 by Ben Gamari at 2022-10-14T18:29:57-04:00 ncg/aarch64: Fix sub-word sign extension yet again In adc7f108141a973b6dcb02a7836eed65d61230e8 we fixed a number of issues to do with sign extension in the AArch64 NCG found by ghc/test-primops>. However, this patch made a critical error, assuming that getSomeReg would allocate a fresh register for the result of its evaluation. However, this is not the case as `getSomeReg (CmmReg r) == r`. Consequently, any mutation of the register returned by `getSomeReg` may have unwanted side-effects on other expressions also mentioning `r`. In the fix listed above, this manifested as the registers containing the operands of binary arithmetic operations being incorrectly sign-extended. This resulted in #22282. Sadly, the rather simple structure of the tests generated by `test-primops` meant that this particular case was not exercised. Even more surprisingly, none of our testsuite caught this case. Here we fix this by ensuring that intermediate sign extension is performed in a fresh register. Fixes #22282. - - - - - 54e41b16 by Teo Camarasu at 2022-10-15T18:09:24+01:00 rts: ensure we are below maxHeapSize after returning megablocks When the heap is heavily block fragmented the live byte size might be low while the memory usage is high. We want to ensure that heap overflow triggers in these cases. We do so by checking that we can return enough megablocks to under maxHeapSize at the end of GC. - - - - - 29bb90db by Teo Camarasu at 2022-10-15T18:09:24+01:00 rts: trigger a major collection if megablock usage exceeds maxHeapSize When the heap is suffering from block fragmentation, live bytes might be low while megablock usage is high. If megablock usage exceeds maxHeapSize, we want to trigger a major GC to try to recover some memory otherwise we will die from a heapOverflow at the end of the GC. Fixes #21927 - - - - - 4a4641ca by Teo Camarasu at 2022-10-15T18:11:29+01:00 Add realease note for #21927 - - - - - c1e5719a by Sebastian Graf at 2022-10-17T11:58:46-04:00 DmdAnal: Look through unfoldings of DataCon wrappers (#22241) Previously, the demand signature we computed upfront for a DataCon wrapper lacked boxity information and was much less precise than the demand transformer for the DataCon worker. In this patch we adopt the solution to look through unfoldings of DataCon wrappers during Demand Analysis, but still attach a demand signature for other passes such as the Simplifier. See `Note [DmdAnal for DataCon wrappers]` for more details. Fixes #22241. - - - - - 8c72411d by Gergo ERDI at 2022-10-17T19:20:04-04:00 Add `Enum (Down a)` instance that swaps `succ` and `pred` See https://github.com/haskell/core-libraries-committee/issues/51 for discussion. The key points driving the implementation are the following two ideas: * For the `Int` type, `comparing (complement @Int)` behaves exactly as an order-swapping `compare @Int`. * `enumFrom @(Down a)` can be implemented in terms of `enumFromThen @a`, if only the corner case of starting at the very end is handled specially - - - - - d80ad2f4 by Alan Zimmerman at 2022-10-17T19:20:40-04:00 Update the check-exact infrastructure to match ghc-exactprint GHC tests the exact print annotations using the contents of utils/check-exact. The same functionality is provided via https://github.com/alanz/ghc-exactprint The latter was updated to ensure it works with all of the files on hackage when 9.2 was released, as well as updated to ensure users of the library could work properly (apply-refact, retrie, etc). This commit brings the changes from ghc-exactprint into GHC/utils/check-exact, adapting for the changes to master. Once it lands, it will form the basis for the 9.4 version of ghc-exactprint. See also discussion around this process at #21355 - - - - - 08ab5419 by Andreas Klebinger at 2022-10-17T19:21:15-04:00 Avoid allocating intermediate lists for non recursive bindings. We do so by having an explicit folding function that doesn't need to allocate intermediate lists first. Fixes #22196 - - - - - ff6275ef by Andreas Klebinger at 2022-10-17T19:21:52-04:00 Testsuite: Add a new tables_next_to_code predicate. And use it to avoid T21710a failing on non-tntc archs. Fixes #22169 - - - - - abb82f38 by Eric Lindblad at 2022-10-17T19:22:33-04:00 example rewrite - - - - - 39beb801 by Eric Lindblad at 2022-10-17T19:22:33-04:00 remove redirect - - - - - 0d9fb651 by Eric Lindblad at 2022-10-17T19:22:33-04:00 use heredoc - - - - - 0fa2d185 by Matthew Pickering at 2022-10-17T19:23:10-04:00 testsuite: Fix typo when setting llvm_ways Since 2014 llvm_ways has been set to [] so none of the tests which use only_ways(llvm_ways) have worked as expected. Hopefully the tests still pass with this typo fix! - - - - - ced664a2 by Krzysztof Gogolewski at 2022-10-17T19:23:10-04:00 Fix T15155l not getting -fllvm - - - - - 0ac60423 by Andreas Klebinger at 2022-10-18T03:34:47-04:00 Fix GHCis interaction with tag inference. I had assumed that wrappers were not inlined in interactive mode. Meaning we would always execute the compiled wrapper which properly takes care of upholding the strict field invariant. This turned out to be wrong. So instead we now run tag inference even when we generate bytecode. In that case only for correctness not performance reasons although it will be still beneficial for runtime in some cases. I further fixed a bug where GHCi didn't tag nullary constructors properly when used as arguments. Which caused segfaults when calling into compiled functions which expect the strict field invariant to be upheld. Fixes #22042 and #21083 ------------------------- Metric Increase: T4801 Metric Decrease: T13035 ------------------------- - - - - - 9ecd1ac0 by M Farkas-Dyck at 2022-10-18T03:35:38-04:00 Make `Functor` a superclass of `TrieMap`, which lets us derive the `map` functions. - - - - - f60244d7 by Ben Gamari at 2022-10-18T03:36:15-04:00 configure: Bump minimum bootstrap GHC version Fixes #22245 - - - - - ba4bd4a4 by Matthew Pickering at 2022-10-18T03:36:55-04:00 Build System: Remove out-of-date comment about make build system Both make and hadrian interleave compilation of modules of different modules and don't respect the package boundaries. Therefore I just remove this comment which points out this "difference". Fixes #22253 - - - - - e1bbd368 by Matthew Pickering at 2022-10-18T16:15:49+02:00 Allow configuration of error message printing This MR implements the idea of #21731 that the printing of a diagnostic method should be configurable at the printing time. The interface of the `Diagnostic` class is modified from: ``` class Diagnostic a where diagnosticMessage :: a -> DecoratedSDoc diagnosticReason :: a -> DiagnosticReason diagnosticHints :: a -> [GhcHint] ``` to ``` class Diagnostic a where type DiagnosticOpts a defaultDiagnosticOpts :: DiagnosticOpts a diagnosticMessage :: DiagnosticOpts a -> a -> DecoratedSDoc diagnosticReason :: a -> DiagnosticReason diagnosticHints :: a -> [GhcHint] ``` and so each `Diagnostic` can implement their own configuration record which can then be supplied by a client in order to dictate how to print out the error message. At the moment this only allows us to implement #21722 nicely but in future it is more natural to separate the configuration of how much information we put into an error message and how much we decide to print out of it. Updates Haddock submodule - - - - - 99dc3e3d by Matthew Pickering at 2022-10-18T16:15:53+02:00 Add -fsuppress-error-contexts to disable printing error contexts in errors In many development environments, the source span is the primary means of seeing what an error message relates to, and the In the expression: and In an equation for: clauses are not particularly relevant. However, they can grow to be quite long, which can make the message itself both feel overwhelming and interact badly with limited-space areas. It's simple to implement this flag so we might as well do it and give the user control about how they see their messages. Fixes #21722 - - - - - 5b3a992f by Dai at 2022-10-19T10:45:45-04:00 Add VecSlot for unboxed sums of SIMD vectors This patch adds the missing `VecRep` case to `primRepSlot` function and all the necessary machinery to carry this new `VecSlot` through code generation. This allows programs involving unboxed sums of SIMD vectors to be written and compiled. Fixes #22187 - - - - - 6d7d9181 by sheaf at 2022-10-19T10:45:45-04:00 Remove SIMD conversions This patch makes it so that packing/unpacking SIMD vectors always uses the right sized types, e.g. unpacking a Word16X4# will give a tuple of Word16#s. As a result, we can get rid of the conversion instructions that were previously required. Fixes #22296 - - - - - 3be48877 by sheaf at 2022-10-19T10:45:45-04:00 Cmm Lint: relax SIMD register assignment check As noted in #22297, SIMD vector registers can be used to store different kinds of values, e.g. xmm1 can be used both to store integer and floating point values. The Cmm type system doesn't properly account for this, so we weaken the Cmm register assignment lint check to only compare widths when comparing a vector type with its allocated vector register. - - - - - f7b7a312 by sheaf at 2022-10-19T10:45:45-04:00 Disable some SIMD tests on non-X86 architectures - - - - - 83638dce by M Farkas-Dyck at 2022-10-19T10:46:29-04:00 Scrub various partiality involving lists (again). Lets us avoid some use of `head` and `tail`, and some panics. - - - - - c3732c62 by M Farkas-Dyck at 2022-10-19T10:47:13-04:00 Enforce invariant of `ListBag` constructor. - - - - - 488d3631 by Bodigrim at 2022-10-19T10:47:52-04:00 More precise types for fields of OverlappingInstances and UnsafeOverlap in TcSolverReportMsg It's clear from asserts in `GHC.Tc.Errors` that `overlappingInstances_matches` and `unsafeOverlapped` are supposed to be non-empty, and `unsafeOverlap_matches` contains a single instance, but these invariants are immediately lost afterwards and not encoded in types. This patch enforces the invariants by pattern matching and makes types more precise, avoiding asserts and partial functions such as `head`. - - - - - 607ce263 by sheaf at 2022-10-19T10:47:52-04:00 Rename unsafeOverlap_matches -> unsafeOverlap_match in UnsafeOverlap - - - - - 1fab9598 by Matthew Pickering at 2022-10-19T10:48:29-04:00 Add SpliceTypes test for hie files This test checks that typed splices and quotes get the right type information when used in hiefiles. See #21619 - - - - - a8b52786 by Jan Hrček at 2022-10-19T10:49:09-04:00 Small language fixes in 'Using GHC' - - - - - 1dab1167 by Gergő Érdi at 2022-10-19T10:49:51-04:00 Fix typo in `Opt_WriteIfSimplifiedCore`'s name - - - - - b17cfc9c by sheaf at 2022-10-19T10:50:37-04:00 TyEq:N assertion: only for saturated applications The assertion that checked TyEq:N in canEqCanLHSFinish incorrectly triggered in the case of an unsaturated newtype TyCon heading the RHS, even though we can't unwrap such an application. Now, we only trigger an assertion failure in case of a saturated application of a newtype TyCon. Fixes #22310 - - - - - ff6f2228 by M Farkas-Dyck at 2022-10-20T16:15:51-04:00 CoreToStg: purge `DynFlags`. - - - - - 1ebd521f by Matthew Pickering at 2022-10-20T16:16:27-04:00 ci: Make fat014 test robust For some reason I implemented this as a makefile test rather than a ghci_script test. Hopefully making it a ghci_script test makes it more robust. Fixes #22313 - - - - - 8cd6f435 by Curran McConnell at 2022-10-21T02:58:01-04:00 remove a no-warn directive from GHC.Cmm.ContFlowOpt This patch is motivated by the desire to remove the {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} directive at the top of GHC.Cmm.ContFlowOpt. (Based on the text in this coding standards doc, I understand it's a goal of the project to remove such directives.) I chose this task because I'm a new contributor to GHC, and it seemed like a good way to get acquainted with the patching process. In order to address the warning that arose when I removed the no-warn directive, I added a case to removeUnreachableBlocksProc to handle the CmmData constructor. Clearly, since this partial function has not been erroring out in the wild, its inputs are always in practice wrapped by the CmmProc constructor. Therefore the CmmData case is handled by a precise panic (which is an improvement over the partial pattern match from before). - - - - - a2af7c4c by Nicolas Trangez at 2022-10-21T02:58:39-04:00 build: get rid of `HAVE_TIME_H` As advertized by `autoreconf`: > All current systems provide time.h; it need not be checked for. Hence, remove the check for it in `configure.ac` and remove conditional inclusion of the header in `HAVE_TIME_H` blocks where applicable. The `time.h` header was being included in various source files without a `HAVE_TIME_H` guard already anyway. - - - - - 25cdc630 by Nicolas Trangez at 2022-10-21T02:58:39-04:00 rts: remove use of `TIME_WITH_SYS_TIME` `autoreconf` will insert an `m4_warning` when the obsolescent `AC_HEADER_TIME` macro is used: > Update your code to rely only on HAVE_SYS_TIME_H, > then remove this warning and the obsolete code below it. > All current systems provide time.h; it need not be checked for. > Not all systems provide sys/time.h, but those that do, all allow > you to include it and time.h simultaneously. Presence of `sys/time.h` was already checked in an earlier `AC_CHECK_HEADERS` invocation, so `AC_HEADER_TIME` can be dropped and guards relying on `TIME_WITH_SYS_TIME` can be reworked to (unconditionally) include `time.h` and include `sys/time.h` based on `HAVE_SYS_TIME_H`. Note the documentation of `AC_HEADER_TIME` in (at least) Autoconf 2.67 says > This macro is obsolescent, as current systems can include both files > when they exist. New programs need not use this macro. - - - - - 1fe7921c by Eric Lindblad at 2022-10-21T02:59:21-04:00 runhaskell - - - - - e3b3986e by David Feuer at 2022-10-21T03:00:00-04:00 Document how to quote certain names with spaces Quoting a name for Template Haskell is a bit tricky if the second character of that name is a single quote. The User's Guide falsely claimed that it was impossible. Document how to do it. Fixes #22236 - - - - - 0eba81e8 by Krzysztof Gogolewski at 2022-10-21T03:00:00-04:00 Fix syntax - - - - - a4dbd102 by Ben Gamari at 2022-10-21T09:11:12-04:00 Fix manifest filename when writing Windows .rc files As noted in #12971, we previously used `show` which resulted in inappropriate escaping of non-ASCII characters. - - - - - 30f0d9a9 by Ben Gamari at 2022-10-21T09:11:12-04:00 Write response files in UTF-8 on Windows This reverts the workaround introduced in f63c8ef33ec9666688163abe4ccf2d6c0428a7e7, which taught our response file logic to write response files with the `latin1` encoding to workaround `gcc`'s lacking Unicode support. This is now no longer necessary (and in fact actively unhelpful) since we rather use Clang. - - - - - b8304648 by M Farkas-Dyck at 2022-10-21T09:11:56-04:00 Scrub some partiality in `GHC.Core.Opt.Simplify.Utils`. - - - - - 09ec7de2 by Teo Camarasu at 2022-10-21T13:23:07-04:00 template-haskell: Improve documentation of strictness annotation types Before it was undocumentated that DecidedLazy can be returned by reifyConStrictness for strict fields. This can happen when a field has an unlifted type or its the single field of a newtype constructor. Fixes #21380 - - - - - 88172069 by M Farkas-Dyck at 2022-10-21T13:23:51-04:00 Delete `eqExpr`, since GHC 9.4 has been released. - - - - - 86e6549e by Ömer Sinan Ağacan at 2022-10-22T07:41:30-04:00 Introduce a standard thunk for allocating strings Currently for a top-level closure in the form hey = unpackCString# x we generate code like this: Main.hey_entry() // [R1] { info_tbls: [(c2T4, label: Main.hey_info rep: HeapRep static { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset c2T4: // global _rqm::P64 = R1; if ((Sp + 8) - 24 < SpLim) (likely: False) goto c2T5; else goto c2T6; c2T5: // global R1 = _rqm::P64; call (stg_gc_enter_1)(R1) args: 8, res: 0, upd: 8; c2T6: // global (_c2T1::I64) = call "ccall" arg hints: [PtrHint, PtrHint] result hints: [PtrHint] newCAF(BaseReg, _rqm::P64); if (_c2T1::I64 == 0) goto c2T3; else goto c2T2; c2T3: // global call (I64[_rqm::P64])() args: 8, res: 0, upd: 8; c2T2: // global I64[Sp - 16] = stg_bh_upd_frame_info; I64[Sp - 8] = _c2T1::I64; R2 = hey1_r2Gg_bytes; Sp = Sp - 16; call GHC.CString.unpackCString#_info(R2) args: 24, res: 0, upd: 24; } } This code is generated for every string literal. Only difference between top-level closures like this is the argument for the bytes of the string (hey1_r2Gg_bytes in the code above). With this patch we introduce a standard thunk in the RTS, called stg_MK_STRING_info, that does what `unpackCString# x` does, except it gets the bytes address from the payload. Using this, for the closure above, we generate this: Main.hey_closure" { Main.hey_closure: const stg_MK_STRING_info; const 0; // padding for indirectee const 0; // static link const 0; // saved info const hey1_r1Gg_bytes; // the payload } This is much smaller in code. Metric Decrease: T10421 T11195 T12150 T12425 T16577 T18282 T18698a T18698b Co-Authored By: Ben Gamari <ben at well-typed.com> - - - - - 1937016b by Andreas Klebinger at 2022-10-22T07:42:06-04:00 hadrian: Improve error for wrong key/value errors. - - - - - 11fe42d8 by Vladislav Zavialov at 2022-10-23T00:11:50+03:00 Class layout info (#19623) Updates the haddock submodule. - - - - - f0a90c11 by Sven Tennie at 2022-10-24T00:12:51-04:00 Pin used way for test cloneMyStack (#21977) cloneMyStack checks the order of closures on the cloned stack. This may change for different ways. Thus we limit this test to one way (normal). - - - - - 0614e74d by Aaron Allen at 2022-10-24T17:11:21+02:00 Convert Diagnostics in GHC.Tc.Gen.Splice (#20116) Replaces uses of `TcRnUnknownMessage` in `GHC.Tc.Gen.Splice` with structured diagnostics. closes #20116 - - - - - 8d2dbe2d by Andreas Klebinger at 2022-10-24T15:59:41-04:00 Improve stg lint for unboxed sums. It now properly lints cases where sums end up distributed over multiple args after unarise. Fixes #22026. - - - - - 41406da5 by Simon Peyton Jones at 2022-10-25T18:07:03-04:00 Fix binder-swap bug This patch fixes #21229 properly, by avoiding doing a binder-swap on dictionary Ids. This is pretty subtle, and explained in Note [Care with binder-swap on dictionaries]. Test is already in simplCore/should_run/T21229 This allows us to restore a feature to the specialiser that we had to revert: see Note [Specialising polymorphic dictionaries]. (This is done in a separate patch.) I also modularised things, using a new function scrutBinderSwap_maybe in all the places where we are (effectively) doing a binder-swap, notably * Simplify.Iteration.addAltUnfoldings * SpecConstr.extendCaseBndrs In Simplify.Iteration.addAltUnfoldings I also eliminated a guard Many <- idMult case_bndr because we concluded, in #22123, that it was doing no good. - - - - - 5a997e16 by Simon Peyton Jones at 2022-10-25T18:07:03-04:00 Make the specialiser handle polymorphic specialisation Ticket #13873 unexpectedly showed that a SPECIALISE pragma made a program run (a lot) slower, because less specialisation took place overall. It turned out that the specialiser was missing opportunities because of quantified type variables. It was quite easy to fix. The story is given in Note [Specialising polymorphic dictionaries] Two other minor fixes in the specialiser * There is no benefit in specialising data constructor /wrappers/. (They can appear overloaded because they are given a dictionary to store in the constructor.) Small guard in canSpecImport. * There was a buglet in the UnspecArg case of specHeader, in the case where there is a dead binder. We need a LitRubbish filler for the specUnfolding stuff. I expanded Note [Drop dead args from specialisations] to explain. There is a 4% increase in compile time for T15164, because we generate more specialised code. This seems OK. Metric Increase: T15164 - - - - - 7f203d00 by Sylvain Henry at 2022-10-25T18:07:43-04:00 Numeric exceptions: replace FFI calls with primops ghc-bignum needs a way to raise numerical exceptions defined in base package. At the time we used FFI calls into primops defined in the RTS. These FFI calls had to be wrapped into hacky bottoming functions because "foreign import prim" syntax doesn't support giving a bottoming demand to the foreign call (cf #16929). These hacky wrapper functions trip up the JavaScript backend (#21078) because they are polymorphic in their return type. This commit replaces them with primops very similar to raise# but raising predefined exceptions. - - - - - 0988a23d by Sylvain Henry at 2022-10-25T18:08:24-04:00 Enable popcount rewrite rule when cross-compiling The comment applies only when host's word size < target's word size. So we can relax the guard. - - - - - a2f53ac8 by Sylvain Henry at 2022-10-25T18:09:05-04:00 Add GHC.SysTools.Cpp module Move doCpp out of the driver to be able to use it in the upcoming JS backend. - - - - - 1fd7f201 by Ben Gamari at 2022-10-25T18:09:42-04:00 llvm-targets: Add datalayouts for big-endian AArch64 targets Fixes #22311. Thanks to @zeldin for the patch. - - - - - f5a486eb by Krzysztof Gogolewski at 2022-10-25T18:10:19-04:00 Cleanup String/FastString conversions Remove unused mkPtrString and isUnderscoreFS. We no longer use mkPtrString since 1d03d8bef96. Remove unnecessary conversions between FastString and String and back. - - - - - f7bfb40c by Ryan Scott at 2022-10-26T00:01:24-04:00 Broaden the in-scope sets for liftEnvSubst and composeTCvSubst This patch fixes two distinct (but closely related) buglets that were uncovered in #22235: * `liftEnvSubst` used an empty in-scope set, which was not wide enough to cover the variables in the range of the substitution. This patch fixes this by populating the in-scope set from the free variables in the range of the substitution. * `composeTCvSubst` applied the first substitution argument to the range of the second substitution argument, but the first substitution's in-scope set was not wide enough to cover the range of the second substutition. We similarly fix this issue in this patch by widening the first substitution's in-scope set before applying it. Fixes #22235. - - - - - 0270cc54 by Vladislav Zavialov at 2022-10-26T00:02:01-04:00 Introduce TcRnWithHsDocContext (#22346) Before this patch, GHC used withHsDocContext to attach an HsDocContext to an error message: addErr $ mkTcRnUnknownMessage $ mkPlainError noHints (withHsDocContext ctxt msg) The problem with this approach is that it only works with TcRnUnknownMessage. But could we attach an HsDocContext to a structured error message in a generic way? This patch solves the problem by introducing a new constructor to TcRnMessage: data TcRnMessage where ... TcRnWithHsDocContext :: !HsDocContext -> !TcRnMessage -> TcRnMessage ... - - - - - 9ab31f42 by Sylvain Henry at 2022-10-26T09:32:20+02:00 Testsuite: more precise test options Necessary for newer cross-compiling backends (JS, Wasm) that don't support TH yet. - - - - - f60a1a62 by Vladislav Zavialov at 2022-10-26T12:17:14-04:00 Use TcRnVDQInTermType in noNestedForallsContextsErr (#20115) When faced with VDQ in the type of a term, GHC generates the following error message: Illegal visible, dependent quantification in the type of a term (GHC does not yet support this) Prior to this patch, there were two ways this message could have been generated and represented: 1. with the dedicated constructor TcRnVDQInTermType (see check_type in GHC.Tc.Validity) 2. with the transitional constructor TcRnUnknownMessage (see noNestedForallsContextsErr in GHC.Rename.Utils) Not only this led to duplication of code generating the final SDoc, it also made it tricky to track the origin of the error message. This patch fixes the problem by using TcRnVDQInTermType exclusively. - - - - - 223e159d by Owen Shepherd at 2022-10-27T13:54:33-04:00 Remove source location information from interface files This change aims to minimize source location information leaking into interface files, which makes ABI hashes dependent on the build location. The `Binary (Located a)` instance has been removed completely. It seems that the HIE interface still needs the ability to serialize SrcSpans, but by wrapping the instances, it should be a lot more difficult to inadvertently add source location information. - - - - - 22e3deb9 by Simon Peyton Jones at 2022-10-27T13:55:37-04:00 Add missing dict binds to specialiser I had forgotten to add the auxiliary dict bindings to the /unfolding/ of a specialised function. This caused #22358, which reports failures when compiling Hackage packages fixed-vector indexed-traversable Regression test T22357 is snarfed from indexed-traversable - - - - - a8ed36f9 by Evan Relf at 2022-10-27T13:56:36-04:00 Fix broken link to `async` package - - - - - 750846cd by Zubin Duggal at 2022-10-28T00:49:22-04:00 Pass correct package db when testing stage1. It used to pick the db for stage-2 which obviously didn't work. - - - - - ad612f55 by Krzysztof Gogolewski at 2022-10-28T00:50:00-04:00 Minor SDoc-related cleanup * Rename pprCLabel to pprCLabelStyle, and use the name pprCLabel for a function using CStyle (analogous to pprAsmLabel) * Move LabelStyle to the CLabel module, it no longer needs to be in Outputable. * Move calls to 'text' right next to literals, to make sure the text/str rule is triggered. * Remove FastString/String roundtrip in Tc.Deriv.Generate * Introduce showSDocForUser', which abstracts over a pattern in GHCi.UI - - - - - c2872f3f by Bryan Richter at 2022-10-28T11:36:34+03:00 CI: Don't run lint-submods on nightly Fixes #22325 - - - - - 270037fa by Hécate Moonlight at 2022-10-28T19:46:12-04:00 Start the deprecation process for GHC.Pack - - - - - d45d8cb3 by M Farkas-Dyck at 2022-11-01T12:47:21-04:00 Drop a kludge for binutils<2.17, which is now over 10 years old. - - - - - 8ee8b418 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: `name` argument of `createOSThread` can be `const` Since we don't intend to ever change the incoming string, declare this to be true. Also, in the POSIX implementation, the argument is no longer `STG_UNUSED` (since ee0deb8054da2a597fc5624469b4c44fd769ada2) in any code path. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2#note_460080 - - - - - 13b5f102 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: fix lifetime of `start_thread`s `name` value Since, unlike the code in ee0deb8054da2^, usage of the `name` value passed to `createOSThread` now outlives said function's lifetime, and could hence be released by the caller by the time the new thread runs `start_thread`, it needs to be copied. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2#note_460080 See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9066 - - - - - edd175c9 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: fix OS thread naming in ticker Since ee0deb805, the use of `pthread_setname_np` on Darwin was fixed when invoking `createOSThread`. However, the 'ticker' has some thread-creation code which doesn't rely on `createOSThread`, yet also uses `pthread_setname_np`. This patch enforces all thread creation to go through a single function, which uses the (correct) thread-naming code introduced in ee0deb805. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2 See: https://gitlab.haskell.org/ghc/ghc/-/issues/22206 See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9066 - - - - - b7a00113 by Krzysztof Gogolewski at 2022-11-01T12:48:35-04:00 Typo: rename -fwrite-if-simplfied-core to -fwrite-if-simplified-core - - - - - 30e625e6 by Vladislav Zavialov at 2022-11-01T12:49:10-04:00 ThToHs: fix overzealous parenthesization Before this patch, when converting from TH.Exp to LHsExpr GhcPs, the compiler inserted more parentheses than required: ((f a) (b + c)) d This was happening because the LHS of the function application was parenthesized as if it was the RHS. Now we use funPrec and appPrec appropriately and produce sensibly parenthesized expressions: f a (b + c) d I also took the opportunity to remove the special case for LamE, which was not special at all and simply duplicated code. - - - - - 0560821f by Simon Peyton Jones at 2022-11-01T12:49:47-04:00 Add accurate skolem info when quantifying Ticket #22379 revealed that skolemiseQuantifiedTyVar was dropping the passed-in skol_info on the floor when it encountered a SkolemTv. Bad! Several TyCons thereby share a single SkolemInfo on their binders, which lead to bogus error reports. - - - - - 38d19668 by Fendor at 2022-11-01T12:50:25-04:00 Expose UnitEnvGraphKey for user-code - - - - - 77e24902 by Simon Peyton Jones at 2022-11-01T12:51:00-04:00 Shrink test case for #22357 Ryan Scott offered a cut-down repro case (60 lines instead of more than 700 lines) - - - - - 4521f649 by Simon Peyton Jones at 2022-11-01T12:51:00-04:00 Add two tests for #17366 - - - - - 6b400d26 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_NORETURN` Instead of sprinkling the codebase with `GNU(C3)_ATTRIBUTE(__noreturn__)`, add a `STG_NORETURN` macro (for, basically, the same thing) similar to `STG_UNUSED` and others, and update the code to use this macro where applicable. - - - - - f9638654 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: consistently use `STG_UNUSED` - - - - - 81a58433 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_USED` Similar to `STG_UNUSED`, have a specific macro for `__attribute__(used)`. - - - - - 41e1f748 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_MALLOC` Instead of using `GNUC3_ATTRIBUTE(__malloc__)`, provide a `STG_MALLOC` macro definition and use it instead. - - - - - 3a9a8bde by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: use `STG_UNUSED` - - - - - 9ab999de by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: specify deallocator of allocating functions This patch adds a new `STG_MALLOC1` macro (and its counterpart `STG_MALLOC2` for completeness) which allows to specify the deallocation function to be used with allocations of allocating functions, and applies it to `stg*allocBytes`. It also fixes a case where `free` was used to free up an `stgMallocBytes` allocation, found by the above change. See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-malloc-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - 81c0c7c9 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: use `alloc_size` attribute This patch adds the `STG_ALLOC_SIZE1` and `STG_ALLOC_SIZE2` macros which allow to set the `alloc_size` attribute on functions, when available. See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-alloc_005fsize-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - 99a1d896 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: add and use `STG_RETURNS_NONNULL` See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-returns_005fnonnull-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - c235b399 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: tag `stgStrndup` as `STG_MALLOC` See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - ed81b448 by Oleg Grenrus at 2022-11-02T12:07:27-04:00 Move Symbol implementation note out of public haddock - - - - - 284fd39c by Ben Gamari at 2022-11-03T01:58:54-04:00 gen-dll: Drop it Currently it is only used by the make build system, which is soon to be retired, and it has not built since 41cf758b. We may need to reintroduce it when dynamic-linking support is introduced on Windows, but we will cross that bridge once we get there. Fixes #21753. - - - - - 24f4f54f by Matthew Pickering at 2022-11-03T01:59:30-04:00 Port foundation numeric tests to GHC testsuite This commit ports the numeric tests which found a regression in GHC-9.4. https://github.com/haskell-foundation/foundation/issues/571 Included in the commit is a simple random number generator and simplified QuickCheck implementation. In future these could be factored out of this standalone file and reused as a general purpose library which could be used for other QuickCheck style tests in the testsuite. See #22282 - - - - - d51bf7bd by M Farkas-Dyck at 2022-11-03T02:00:13-04:00 git: ignore HIE files. Cleans up git status if one sets -fwrite-ide-info in hadrian/ghci. - - - - - a9fc15b1 by Matthew Pickering at 2022-11-03T02:00:49-04:00 Clarify status of bindings in WholeCoreBindings Gergo points out that these bindings are tidied, rather than prepd as the variable claims. Therefore we update the name of the variable to reflect reality and add a comment to the data type to try to erase any future confusion. Fixes #22307 - - - - - 634da448 by Bodigrim at 2022-11-03T21:25:02+00:00 Fix haddocks for GHC.IORef - - - - - 31125154 by Andreas Klebinger at 2022-11-03T23:08:09-04:00 Export pprTrace and friends from GHC.Prelude. Introduces GHC.Prelude.Basic which can be used in modules which are a dependency of the ppr code. - - - - - bdc8cbb3 by Bryan Richter at 2022-11-04T10:27:37+02:00 CI: Allow hadrian-ghc-in-ghci to run in nightlies Since lint-submods doesn't run in nightlies, hadrian-ghc-in-ghci needs to mark it as "optional" so it can run if the job doesn't exist. Fixes #22396. - - - - - 3c0e3793 by Krzysztof Gogolewski at 2022-11-05T00:29:57-04:00 Minor refactor around FastStrings Pass FastStrings to functions directly, to make sure the rule for fsLit "literal" fires. Remove SDoc indirection in GHCi.UI.Tags and GHC.Unit.Module.Graph. - - - - - e41b2f55 by Matthew Pickering at 2022-11-05T14:18:10+00:00 Bump unix submodule to 2.8.0.0 Also bumps process and ghc-boot bounds on unix. For hadrian, when cross-compiling, we add -Wwarn=unused-imports -Wwarn=unused-top-binds to validation flavour. Further fixes in unix and/or hsc2hs is needed to make it completely free of warnings; for the time being, this change is needed to unblock other cross-compilation related work. - - - - - 42938a58 by Matthew Pickering at 2022-11-05T14:18:10+00:00 Bump Win32 submodule to 2.13.4.0 Fixes #22098 - - - - - e7372bc5 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump ci-images revision ci-images has recently been updated, including changes needed for wasm32-wasi CI. - - - - - 88cb9492 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump gmp-tarballs submodule Includes a fix for wasm support, doesn't impact other targets. - - - - - 69427ce9 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump haskeline submodule Includes a fix for wasm support, doesn't impact other targets. - - - - - 5fe11fe6 by Carter Schonwald at 2022-11-07T13:22:14-05:00 bump llvm upper bound - - - - - 68f49874 by M Farkas-Dyck at 2022-11-08T12:53:55-05:00 Define `Infinite` list and use where appropriate. Also add perf test for infinite list fusion. In particular, in `GHC.Core`, often we deal with infinite lists of roles. Also in a few locations we deal with infinite lists of names. Thanks to simonpj for helping to write the Note [Fusion for `Infinite` lists]. - - - - - ce726cd2 by Ross Paterson at 2022-11-08T12:54:34-05:00 Fix TypeData issues (fixes #22315 and #22332) There were two bugs here: 1. Treating type-level constructors as PromotedDataCon doesn't always work, in particular because constructors promoted via DataKinds are called both T and 'T. (Tests T22332a, T22332b, T22315a, T22315b) Fix: guard these cases with isDataKindsPromotedDataCon. 2. Type-level constructors were sent to the code generator, producing things like constructor wrappers. (Tests T22332a, T22332b) Fix: test for them in isDataTyCon. Other changes: * changed the marking of "type data" DataCon's as suggested by SPJ. * added a test TDGADT for a type-level GADT. * comment tweaks * change tcIfaceTyCon to ignore IfaceTyConInfo, so that IfaceTyConInfo is used only for pretty printing, not for typechecking. (SPJ) - - - - - 132f8908 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Clarify msum/asum documentation - - - - - bb5888c5 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Add example for (<$) - - - - - 080fffa1 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Document what Alternative/MonadPlus instances actually do - - - - - 92ccb8de by Giles Anderson at 2022-11-09T09:27:52-05:00 Use TcRnDiagnostic in GHC.Tc.TyCl.Instance (#20117) The following `TcRnDiagnostic` messages have been introduced: TcRnWarnUnsatisfiedMinimalDefinition TcRnMisplacedInstSig TcRnBadBootFamInstDeclErr TcRnIllegalFamilyInstance TcRnAssocInClassErr TcRnBadFamInstDecl TcRnNotOpenFamily - - - - - 90c5abd4 by Hécate Moonlight at 2022-11-09T09:28:30-05:00 GHCi tags generation phase 2 see #19884 - - - - - f9f17b68 by Simon Peyton Jones at 2022-11-10T12:20:03+00:00 Fire RULES in the Specialiser The Specialiser has, for some time, fires class-op RULES in the specialiser itself: see Note [Specialisation modulo dictionary selectors] This MR beefs it up a bit, so that it fires /all/ RULES in the specialiser, not just class-op rules. See Note [Fire rules in the specialiser] The result is a bit more specialisation; see test simplCore/should_compile/T21851_2 This pushed me into a bit of refactoring. I made a new data types GHC.Core.Rules.RuleEnv, which combines - the several source of rules (local, home-package, external) - the orphan-module dependencies in a single record for `getRules` to consult. That drove a bunch of follow-on refactoring, including allowing me to remove cr_visible_orphan_mods from the CoreReader data type. I moved some of the RuleBase/RuleEnv stuff into GHC.Core.Rule. The reorganisation in the Simplifier improve compile times a bit (geom mean -0.1%), but T9961 is an outlier Metric Decrease: T9961 - - - - - 2b3d0bee by Simon Peyton Jones at 2022-11-10T12:21:13+00:00 Make indexError work better The problem here is described at some length in Note [Boxity for bottoming functions] and Note [Reboxed crud for bottoming calls] in GHC.Core.Opt.DmdAnal. This patch adds a SPECIALISE pragma for indexError, which makes it much less vulnerable to the problem described in these Notes. (This came up in another line of work, where a small change made indexError do reboxing (in nofib/spectral/simple/table_sort) that didn't happen before my change. I've opened #22404 to document the fagility. - - - - - 399e921b by Simon Peyton Jones at 2022-11-10T12:21:14+00:00 Fix DsUselessSpecialiseForClassMethodSelector msg The error message for DsUselessSpecialiseForClassMethodSelector was just wrong (a typo in some earlier work); trivial fix - - - - - dac0682a by Sebastian Graf at 2022-11-10T21:16:01-05:00 WorkWrap: Unboxing unboxed tuples is not always useful (#22388) See Note [Unboxing through unboxed tuples]. Fixes #22388. - - - - - 1230c268 by Sebastian Graf at 2022-11-10T21:16:01-05:00 Boxity: Handle argument budget of unboxed tuples correctly (#21737) Now Budget roughly tracks the combined width of all arguments after unarisation. See the changes to `Note [Worker argument budgets]`. Fixes #21737. - - - - - 2829fd92 by Cheng Shao at 2022-11-11T00:26:54-05:00 autoconf: check getpid getuid raise This patch adds checks for getpid, getuid and raise in autoconf. These functions are absent in wasm32-wasi and thus needs to be checked. - - - - - f5dfd1b4 by Cheng Shao at 2022-11-11T00:26:55-05:00 hadrian: add -Wwarn only for cross-compiling unix - - - - - 2e6ab453 by Cheng Shao at 2022-11-11T00:26:55-05:00 hadrian: add targetSupportsThreadedRts flag This patch adds a targetSupportsThreadedRts flag to indicate whether the target supports the threaded rts at all, different from existing targetSupportsSMP that checks whether -N is supported by the RTS. All existing flavours have also been updated accordingly to respect this flags. Some targets (e.g. wasm32-wasi) does not support the threaded rts, therefore this flag is needed for the default flavours to work. It makes more sense to have proper autoconf logic to check for threading support, but for the time being, we just set the flag to False iff the target is wasm32. - - - - - 8104f6f5 by Cheng Shao at 2022-11-11T00:26:55-05:00 Fix Cmm symbol kind - - - - - b2035823 by Norman Ramsey at 2022-11-11T00:26:55-05:00 add the two key graph modules from Martin Erwig's FGL Martin Erwig's FGL (Functional Graph Library) provides an "inductive" representation of graphs. A general graph has labeled nodes and labeled edges. The key operation on a graph is to decompose it by removing one node, together with the edges that connect the node to the rest of the graph. There is also an inverse composition operation. The decomposition and composition operations make this representation of graphs exceptionally well suited to implement graph algorithms in which the graph is continually changing, as alluded to in #21259. This commit adds `GHC.Data.Graph.Inductive.Graph`, which defines the interface, and `GHC.Data.Graph.Inductive.PatriciaTree`, which provides an implementation. Both modules are taken from `fgl-5.7.0.3` on Hackage, with these changes: - Copyright and license text have been copied into the files themselves, not stored separately. - Some calls to `error` have been replaced with calls to `panic`. - Conditional-compilation support for older versions of GHC, `containers`, and `base` has been removed. - - - - - 3633a5f5 by Norman Ramsey at 2022-11-11T00:26:55-05:00 add new modules for reducibility and WebAssembly translation - - - - - df7bfef8 by Cheng Shao at 2022-11-11T00:26:55-05:00 Add support for the wasm32-wasi target tuple This patch adds the wasm32-wasi tuple support to various places in the tree: autoconf, hadrian, ghc-boot and also the compiler. The codegen logic will come in subsequent commits. - - - - - 32ae62e6 by Cheng Shao at 2022-11-11T00:26:55-05:00 deriveConstants: parse .ll output for wasm32 due to broken nm This patch makes deriveConstants emit and parse an .ll file when targeting wasm. It's a necessary workaround for broken llvm-nm on wasm, which isn't capable of reporting correct constant values when parsing an object. - - - - - 07e92c92 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: workaround cmm's improper variadic ccall breaking wasm32 typechecking Unlike other targets, wasm requires the function signature of the call site and callee to strictly match. So in Cmm, when we call a C function that actually returns a value, we need to add an _unused local variable to receive it, otherwise type error awaits. An even bigger problem is calling variadic functions like barf() and such. Cmm doesn't support CAPI calling convention yet, so calls to variadic functions just happen to work in some cases with some target's ABI. But again, it doesn't work with wasm. Fortunately, the wasm C ABI lowers varargs to a stack pointer argument, and it can be passed NULL when no other arguments are expected to be passed. So we also add the additional unused NULL arguments to those functions, so to fix wasm, while not affecting behavior on other targets. - - - - - 00124d12 by Cheng Shao at 2022-11-11T00:26:55-05:00 testsuite: correct sleep() signature in T5611 In libc, sleep() returns an integer. The ccall type signature should match the libc definition, otherwise it causes linker error on wasm. - - - - - d72466a9 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: prefer ffi_type_void over FFI_TYPE_VOID This patch uses ffi_type_void instead of FFI_TYPE_VOID in the interpreter code, since the FFI_TYPE_* macros are not available in libffi-wasm32 yet. The libffi public documentation also only mentions the lower-case ffi_type_* symbols, so we should prefer the lower-case API here. - - - - - 4d36a1d3 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: don't define RTS_USER_SIGNALS when signal.h is not present In the rts, we have a RTS_USER_SIGNALS macro, and most signal-related logic is guarded with RTS_USER_SIGNALS. This patch extends the range of code guarded with RTS_USER_SIGNALS, and define RTS_USER_SIGNALS iff signal.h is actually detected by autoconf. This is required for wasm32-wasi to work, which lacks signals. - - - - - 3f1e164f by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: use HAVE_GETPID to guard subprocess related logic We've previously added detection of getpid() in autoconf. This patch uses HAVE_GETPID to guard some subprocess related logic in the RTS. This is required for certain targets like wasm32-wasi, where there isn't a process model at all. - - - - - 50bf5e77 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: IPE.c: don't do mutex stuff when THREADED_RTS is not defined This patch adds the missing THREADED_RTS CPP guard to mutex logic in IPE.c. - - - - - ed3b3da0 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: genericRaise: use exit() instead when not HAVE_RAISE We check existence of raise() in autoconf, and here, if not HAVE_RAISE, we should use exit() instead in genericRaise. - - - - - c0ba1547 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: checkSuid: don't do it when not HAVE_GETUID When getuid() is not present, don't do checkSuid since it doesn't make sense anyway on that target. - - - - - d2d6dfd2 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: wasm32 placeholder linker This patch adds minimal placeholder linker logic for wasm32, just enough to unblock compiling rts on wasm32. RTS linker functionality is not properly implemented yet for wasm32. - - - - - 65ba3285 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsStartup: chdir to PWD on wasm32 This patch adds a wasm32-specific behavior to RtsStartup logic. When the PWD environment variable is present, we chdir() to it first. The point is to workaround an issue in wasi-libc: it's currently not possible to specify the initial working directory, it always defaults to / (in the virtual filesystem mapped from some host directory). For some use cases this is sufficient, but there are some other cases (e.g. in the testsuite) where the program needs to access files outside. - - - - - 65b82542 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: no timer for wasm32 Due to the lack of threads, on wasm32 there can't be a background timer that periodically resets the context switch flag. This patch disables timer for wasm32, and also makes the scheduler default to -C0 on wasm32 to avoid starving threads. - - - - - e007586f by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsSymbols: empty RTS_POSIX_ONLY_SYMBOLS for wasm32 The default RTS_POSIX_ONLY_SYMBOLS doesn't make sense on wasm32. - - - - - 0e33f667 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: Schedule: no FORKPROCESS_PRIMOP_SUPPORTED on wasm32 On wasm32 there isn't a process model at all, so no FORKPROCESS_PRIMOP_SUPPORTED. - - - - - 88bbdb31 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: LibffiAdjustor: adapt to ffi_alloc_prep_closure interface for wasm32 libffi-wasm32 only supports non-standard libffi closure api via ffi_alloc_prep_closure(). This patch implements ffi_alloc_prep_closure() via standard libffi closure api on other targets, and uses it to implement adjustor functionality. - - - - - 15138746 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: don't return memory to OS on wasm32 This patch makes the storage manager not return any memory on wasm32. The detailed reason is described in Note [Megablock allocator on wasm]. - - - - - 631af3cc by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: make flushExec a no-op on wasm32 This patch makes flushExec a no-op on wasm32, since there's no such thing as executable memory on wasm32 in the first place. - - - - - 654a3d46 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsStartup: don't call resetTerminalSettings, freeThreadingResources on wasm32 This patch prevents resetTerminalSettings and freeThreadingResources to be called on wasm32, since there is no TTY or threading on wasm32 at all. - - - - - f271e7ca by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: OSThreads.h: stub types for wasm32 This patch defines stub Condition/Mutex/OSThreadId/ThreadLocalKey types for wasm32, just enough to unblock compiling RTS. Any threading-related functionality has been patched to be disabled on wasm32. - - - - - a6ac67b0 by Cheng Shao at 2022-11-11T00:26:55-05:00 Add register mapping for wasm32 This patch adds register mapping logic for wasm32. See Note [Register mapping on WebAssembly] in wasm32 NCG for more description. - - - - - d7b33982 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: wasm32 specific logic This patch adds the rest of wasm32 specific logic in rts. - - - - - 7f59b0f3 by Cheng Shao at 2022-11-11T00:26:55-05:00 base: fall back to using monotonic clock to emulate cputime on wasm32 On wasm32, we have to fall back to using monotonic clock to emulate cputime, since there's no native support for cputime as a clock id. - - - - - 5fcbae0b by Cheng Shao at 2022-11-11T00:26:55-05:00 base: more autoconf checks for wasm32 This patch adds more autoconf checks to base, since those functions and headers may exist on other POSIX systems but don't exist on wasm32. - - - - - 00a9359f by Cheng Shao at 2022-11-11T00:26:55-05:00 base: avoid using unsupported posix functionality on wasm32 This base patch avoids using unsupported posix functionality on wasm32. - - - - - 34b8f611 by Cheng Shao at 2022-11-11T00:26:55-05:00 autoconf: set CrossCompiling=YES in cross bindist configure This patch fixes the bindist autoconf logic to properly set CrossCompiling=YES when it's a cross GHC bindist. - - - - - 5ebeaa45 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: add util functions for UniqFM and UniqMap This patch adds addToUFM_L (backed by insertLookupWithKey), addToUniqMap_L and intersectUniqMap_C. These UniqFM/UniqMap util functions are used by the wasm32 NCG. - - - - - 177c56c1 by Cheng Shao at 2022-11-11T00:26:55-05:00 driver: avoid -Wl,--no-as-needed for wasm32 The driver used to pass -Wl,--no-as-needed for LLD linking. This is actually only supported for ELF targets, and must be avoided when linking for wasm32. - - - - - 06f01c74 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: allow big arith for wasm32 This patch enables Cmm big arithmetic on wasm32, since 64-bit arithmetic can be efficiently lowered to wasm32 opcodes. - - - - - df6bb112 by Cheng Shao at 2022-11-11T00:26:55-05:00 driver: pass -Wa,--no-type-check for wasm32 when runAsPhase This patch passes -Wa,--no-type-check for wasm32 when compiling assembly. See the added note for more detailed explanation. - - - - - c1fe4ab6 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: enforce cmm switch planning for wasm32 This patch forcibly enable Cmm switch planning for wasm32, since otherwise the switch tables we generate may exceed the br_table maximum allowed size. - - - - - a8adc71e by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: annotate CmmFileEmbed with blob length This patch adds the blob length field to CmmFileEmbed. The wasm32 NCG needs to know the precise size of each data segment. - - - - - 36340328 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: wasm32 NCG This patch adds the wasm32 NCG. - - - - - 435f42ea by Cheng Shao at 2022-11-11T00:26:55-05:00 ci: add wasm32-wasi release bindist job - - - - - d8262fdc by Cheng Shao at 2022-11-11T00:26:55-05:00 ci: add a stronger test for cross bindists This commit adds a simple GHC API program that parses and reprints the original hello world program used for basic testing of cross bindists. Before there's full cross-compilation support in the test suite driver, this provides better coverage than the original test. - - - - - 8e6ae882 by Cheng Shao at 2022-11-11T00:26:55-05:00 CODEOWNERS: add wasm-specific maintainers - - - - - 707d5651 by Zubin Duggal at 2022-11-11T00:27:31-05:00 Clarify that LLVM upper bound is non-inclusive during configure (#22411) - - - - - 430eccef by Ben Gamari at 2022-11-11T13:16:45-05:00 rts: Check for program_invocation_short_name via autoconf Instead of assuming support on all Linuxes. - - - - - 6dab0046 by Matthew Pickering at 2022-11-11T13:17:22-05:00 driver: Fix -fdefer-diagnostics flag The `withDeferredDiagnostics` wrapper wasn't doing anything because the session it was modifying wasn't used in hsc_env. Therefore the fix is simple, just push the `getSession` call into the scope of `withDeferredDiagnostics`. Fixes #22391 - - - - - d0c691b6 by Simon Peyton Jones at 2022-11-11T13:18:07-05:00 Add a fast path for data constructor workers See Note [Fast path for data constructors] in GHC.Core.Opt.Simplify.Iteration This bypasses lots of expensive logic, in the special case of applications of data constructors. It is a surprisingly worthwhile improvement, as you can see in the figures below. Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Read(normal) -2.0% CoOpt_Singletons(normal) -2.0% ManyConstructors(normal) -1.3% T10421(normal) -1.9% GOOD T10421a(normal) -1.5% T10858(normal) -1.6% T11545(normal) -1.7% T12234(optasm) -1.3% T12425(optasm) -1.9% GOOD T13035(normal) -1.0% GOOD T13056(optasm) -1.8% T13253(normal) -3.3% GOOD T15164(normal) -1.7% T15304(normal) -3.4% T15630(normal) -2.8% T16577(normal) -4.3% GOOD T17096(normal) -1.1% T17516(normal) -3.1% T18282(normal) -1.9% T18304(normal) -1.2% T18698a(normal) -1.2% GOOD T18698b(normal) -1.5% GOOD T18923(normal) -1.3% T1969(normal) -1.3% GOOD T19695(normal) -4.4% GOOD T21839c(normal) -2.7% GOOD T21839r(normal) -2.7% GOOD T4801(normal) -3.8% GOOD T5642(normal) -3.1% GOOD T6048(optasm) -2.5% GOOD T9020(optasm) -2.7% GOOD T9630(normal) -2.1% GOOD T9961(normal) -11.7% GOOD WWRec(normal) -1.0% geo. mean -1.1% minimum -11.7% maximum +0.1% Metric Decrease: T10421 T12425 T13035 T13253 T16577 T18698a T18698b T1969 T19695 T21839c T21839r T4801 T5642 T6048 T9020 T9630 T9961 - - - - - 3c37d30b by Krzysztof Gogolewski at 2022-11-11T19:18:39+01:00 Use a more efficient printer for code generation (#21853) The changes in `GHC.Utils.Outputable` are the bulk of the patch and drive the rest. The types `HLine` and `HDoc` in Outputable can be used instead of `SDoc` and support printing directly to a handle with `bPutHDoc`. See Note [SDoc versus HDoc] and Note [HLine versus HDoc]. The classes `IsLine` and `IsDoc` are used to make the existing code polymorphic over `HLine`/`HDoc` and `SDoc`. This is done for X86, PPC, AArch64, DWARF and dependencies (printing module names, labels etc.). Co-authored-by: Alexis King <lexi.lambda at gmail.com> Metric Decrease: CoOpt_Read ManyAlternatives ManyConstructors T10421 T12425 T12707 T13035 T13056 T13253 T13379 T18140 T18282 T18698a T18698b T1969 T20049 T21839c T21839r T3064 T3294 T4801 T5321FD T5321Fun T5631 T6048 T783 T9198 T9233 - - - - - 6b92b47f by Matthew Craven at 2022-11-11T18:32:14-05:00 Weaken wrinkle 1 of Note [Scrutinee Constant Folding] Fixes #22375. Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 154c70f6 by Simon Peyton Jones at 2022-11-11T23:40:10+00:00 Fix fragile RULE setup in GHC.Float In testing my type-vs-constraint patch I found that the handling of Natural literals was very fragile -- and I somehow tripped that fragility in my work. So this patch fixes the fragility. See Note [realToFrac natural-to-float] This made a big (9%) difference in one existing test in perf/should_run/T1-359 Metric Decrease: T10359 - - - - - 778c6adc by Simon Peyton Jones at 2022-11-11T23:40:10+00:00 Type vs Constraint: finally nailed This big patch addresses the rats-nest of issues that have plagued us for years, about the relationship between Type and Constraint. See #11715/#21623. The main payload of the patch is: * To introduce CONSTRAINT :: RuntimeRep -> Type * To make TYPE and CONSTRAINT distinct throughout the compiler Two overview Notes in GHC.Builtin.Types.Prim * Note [TYPE and CONSTRAINT] * Note [Type and Constraint are not apart] This is the main complication. The specifics * New primitive types (GHC.Builtin.Types.Prim) - CONSTRAINT - ctArrowTyCon (=>) - tcArrowTyCon (-=>) - ccArrowTyCon (==>) - funTyCon FUN -- Not new See Note [Function type constructors and FunTy] and Note [TYPE and CONSTRAINT] * GHC.Builtin.Types: - New type Constraint = CONSTRAINT LiftedRep - I also stopped nonEmptyTyCon being built-in; it only needs to be wired-in * Exploit the fact that Type and Constraint are distinct throughout GHC - Get rid of tcView in favour of coreView. - Many tcXX functions become XX functions. e.g. tcGetCastedTyVar --> getCastedTyVar * Kill off Note [ForAllTy and typechecker equality], in (old) GHC.Tc.Solver.Canonical. It said that typechecker-equality should ignore the specified/inferred distinction when comparein two ForAllTys. But that wsa only weakly supported and (worse) implies that we need a separate typechecker equality, different from core equality. No no no. * GHC.Core.TyCon: kill off FunTyCon in data TyCon. There was no need for it, and anyway now we have four of them! * GHC.Core.TyCo.Rep: add two FunTyFlags to FunCo See Note [FunCo] in that module. * GHC.Core.Type. Lots and lots of changes driven by adding CONSTRAINT. The key new function is sORTKind_maybe; most other changes are built on top of that. See also `funTyConAppTy_maybe` and `tyConAppFun_maybe`. * Fix a longstanding bug in GHC.Core.Type.typeKind, and Core Lint, in kinding ForAllTys. See new tules (FORALL1) and (FORALL2) in GHC.Core.Type. (The bug was that before (forall (cv::t1 ~# t2). blah), where blah::TYPE IntRep, would get kind (TYPE IntRep), but it should be (TYPE LiftedRep). See Note [Kinding rules for types] in GHC.Core.Type. * GHC.Core.TyCo.Compare is a new module in which we do eqType and cmpType. Of course, no tcEqType any more. * GHC.Core.TyCo.FVs. I moved some free-var-like function into this module: tyConsOfType, visVarsOfType, and occCheckExpand. Refactoring only. * GHC.Builtin.Types. Compiletely re-engineer boxingDataCon_maybe to have one for each /RuntimeRep/, rather than one for each /Type/. This dramatically widens the range of types we can auto-box. See Note [Boxing constructors] in GHC.Builtin.Types The boxing types themselves are declared in library ghc-prim:GHC.Types. GHC.Core.Make. Re-engineer the treatment of "big" tuples (mkBigCoreVarTup etc) GHC.Core.Make, so that it auto-boxes unboxed values and (crucially) types of kind Constraint. That allows the desugaring for arrows to work; it gathers up free variables (including dictionaries) into tuples. See Note [Big tuples] in GHC.Core.Make. There is still work to do here: #22336. But things are better than before. * GHC.Core.Make. We need two absent-error Ids, aBSENT_ERROR_ID for types of kind Type, and aBSENT_CONSTRAINT_ERROR_ID for vaues of kind Constraint. Ditto noInlineId vs noInlieConstraintId in GHC.Types.Id.Make; see Note [inlineId magic]. * GHC.Core.TyCo.Rep. Completely refactor the NthCo coercion. It is now called SelCo, and its fields are much more descriptive than the single Int we used to have. A great improvement. See Note [SelCo] in GHC.Core.TyCo.Rep. * GHC.Core.RoughMap.roughMatchTyConName. Collapse TYPE and CONSTRAINT to a single TyCon, so that the rough-map does not distinguish them. * GHC.Core.DataCon - Mainly just improve documentation * Some significant renamings: GHC.Core.Multiplicity: Many --> ManyTy (easier to grep for) One --> OneTy GHC.Core.TyCo.Rep TyCoBinder --> GHC.Core.Var.PiTyBinder GHC.Core.Var TyCoVarBinder --> ForAllTyBinder AnonArgFlag --> FunTyFlag ArgFlag --> ForAllTyFlag GHC.Core.TyCon TyConTyCoBinder --> TyConPiTyBinder Many functions are renamed in consequence e.g. isinvisibleArgFlag becomes isInvisibleForAllTyFlag, etc * I refactored FunTyFlag (was AnonArgFlag) into a simple, flat data type data FunTyFlag = FTF_T_T -- (->) Type -> Type | FTF_T_C -- (-=>) Type -> Constraint | FTF_C_T -- (=>) Constraint -> Type | FTF_C_C -- (==>) Constraint -> Constraint * GHC.Tc.Errors.Ppr. Some significant refactoring in the TypeEqMisMatch case of pprMismatchMsg. * I made the tyConUnique field of TyCon strict, because I saw code with lots of silly eval's. That revealed that GHC.Settings.Constants.mAX_SUM_SIZE can only be 63, because we pack the sum tag into a 6-bit field. (Lurking bug squashed.) Fixes * #21530 Updates haddock submodule slightly. Performance changes ~~~~~~~~~~~~~~~~~~~ I was worried that compile times would get worse, but after some careful profiling we are down to a geometric mean 0.1% increase in allocation (in perf/compiler). That seems fine. There is a big runtime improvement in T10359 Metric Decrease: LargeRecord MultiLayerModulesTH_OneShot T13386 T13719 Metric Increase: T8095 - - - - - 360f5fec by Simon Peyton Jones at 2022-11-11T23:40:11+00:00 Indent closing "#-}" to silence HLint - - - - - e160cf47 by Krzysztof Gogolewski at 2022-11-12T08:05:28-05:00 Fix merge conflict in T18355.stderr Fixes #22446 - - - - - 294f9073 by Simon Peyton Jones at 2022-11-12T23:14:13+00:00 Fix a trivial typo in dataConNonlinearType Fixes #22416 - - - - - 268a3ce9 by Ben Gamari at 2022-11-14T09:36:57-05:00 eventlog: Ensure that IPE output contains actual info table pointers The refactoring in 866c736e introduced a rather subtle change in the semantics of the IPE eventlog output, changing the eventlog field from encoding info table pointers to "TNTC pointers" (which point to entry code when tables-next-to-code is enabled). Fix this. Fixes #22452. - - - - - d91db679 by Matthew Pickering at 2022-11-14T16:48:10-05:00 testsuite: Add tests for T22347 These are fixed in recent versions but might as well add regression tests. See #22347 - - - - - 8f6c576b by Matthew Pickering at 2022-11-14T16:48:45-05:00 testsuite: Improve output from tests which have failing pre_cmd There are two changes: * If a pre_cmd fails, then don't attempt to run the test. * If a pre_cmd fails, then print the stdout and stderr from running that command (which hopefully has a nice error message). For example: ``` =====> 1 of 1 [0, 0, 0] *** framework failure for test-defaulting-plugin(normal) pre_cmd failed: 2 ** pre_cmd was "$MAKE -s --no-print-directory -C defaulting-plugin package.test-defaulting-plugin TOP={top}". stdout: stderr: DefaultLifted.hs:19:13: error: [GHC-76037] Not in scope: type constructor or class ‘Typ’ Suggested fix: Perhaps use one of these: ‘Type’ (imported from GHC.Tc.Utils.TcType), data constructor ‘Type’ (imported from GHC.Plugins) | 19 | instance Eq Typ where | ^^^ make: *** [Makefile:17: package.test-defaulting-plugin] Error 1 Performance Metrics (test environment: local): ``` Fixes #22329 - - - - - 2b7d5ccc by Madeline Haraj at 2022-11-14T22:44:17+00:00 Implement UNPACK support for sum types. This is based on osa's unpack_sums PR from ages past. The meat of the patch is implemented in dataConArgUnpackSum and described in Note [UNPACK for sum types]. - - - - - 78f7ecb0 by Andreas Klebinger at 2022-11-14T22:20:29-05:00 Expand on the need to clone local binders. Fixes #22402. - - - - - 65ce43cc by Krzysztof Gogolewski at 2022-11-14T22:21:05-05:00 Fix :i Constraint printing "type Constraint = Constraint" Since Constraint became a synonym for CONSTRAINT 'LiftedRep, we need the same code for handling printing as for the synonym Type = TYPE 'LiftedRep. This addresses the same bug as #18594, so I'm reusing the test. - - - - - 94549f8f by ARATA Mizuki at 2022-11-15T21:36:03-05:00 configure: Don't check for an unsupported version of LLVM The upper bound is not inclusive. Fixes #22449 - - - - - 02d3511b by Bodigrim at 2022-11-15T21:36:41-05:00 Fix capitalization in haddock for TestEquality - - - - - 08bf2881 by Cheng Shao at 2022-11-16T09:16:29+00:00 base: make Foreign.Marshal.Pool use RTS internal arena for allocation `Foreign.Marshal.Pool` used to call `malloc` once for each allocation request. Each `Pool` maintained a list of allocated pointers, and traverses the list to `free` each one of those pointers. The extra O(n) overhead is apparently bad for a `Pool` that serves a lot of small allocation requests. This patch uses the RTS internal arena to implement `Pool`, with these benefits: - Gets rid of the extra O(n) overhead. - The RTS arena is simply a bump allocator backed by the block allocator, each allocation request is likely faster than a libc `malloc` call. Closes #14762 #18338. - - - - - 37cfe3c0 by Krzysztof Gogolewski at 2022-11-16T14:50:06-05:00 Misc cleanup * Replace catMaybes . map f with mapMaybe f * Use concatFS to concatenate multiple FastStrings * Fix documentation of -exclude-module * Cleanup getIgnoreCount in GHCi.UI - - - - - b0ac3813 by Lawton Nichols at 2022-11-19T03:22:14-05:00 Give better errors for code corrupted by Unicode smart quotes (#21843) Previously, we emitted a generic and potentially confusing error during lexical analysis on programs containing smart quotes (“/”/‘/’). This commit adds smart quote-aware lexer errors. - - - - - cb8430f8 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Make OpaqueNo* tests less noisy to unrelated changes - - - - - b1a8af69 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Simplifier: Consider `seq` as a `BoringCtxt` (#22317) See `Note [Seq is boring]` for the rationale. Fixes #22317. - - - - - 9fd11585 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Make T21839c's ghc/max threshold more forgiving - - - - - 4b6251ab by Simon Peyton Jones at 2022-11-19T03:23:24-05:00 Be more careful when reporting unbound RULE binders See Note [Variables unbound on the LHS] in GHC.HsToCore.Binds. Fixes #22471. - - - - - e8f2b80d by Peter Trommler at 2022-11-19T03:23:59-05:00 PPC NCG: Fix generating assembler code Fixes #22479 - - - - - f2f9ef07 by Bodigrim at 2022-11-20T18:39:30-05:00 Extend documentation for Data.IORef - - - - - ef511b23 by Simon Peyton Jones at 2022-11-20T18:40:05-05:00 Buglet in GHC.Tc.Module.checkBootTyCon This lurking bug used the wrong function to compare two types in GHC.Tc.Module.checkBootTyCon It's hard to trigger the bug, which only came up during !9343, so there's no regression test in this MR. - - - - - 451aeac3 by Bodigrim at 2022-11-20T18:40:44-05:00 Add since pragmas for c_interruptible_open and hostIsThreaded - - - - - 8d6aaa49 by Duncan Coutts at 2022-11-22T02:06:16-05:00 Introduce CapIOManager as the per-cap I/O mangager state Rather than each I/O manager adding things into the Capability structure ad-hoc, we should have a common CapIOManager iomgr member of the Capability structure, with a common interface to initialise etc. The content of the CapIOManager struct will be defined differently for each I/O manager implementation. Eventually we should be able to have the CapIOManager be opaque to the rest of the RTS, and known just to the I/O manager implementation. We plan for that by making the Capability contain a pointer to the CapIOManager rather than containing the structure directly. Initially just move the Unix threaded I/O manager's control FD. - - - - - 8901285e by Duncan Coutts at 2022-11-22T02:06:17-05:00 Add hook markCapabilityIOManager To allow I/O managers to have GC roots in the Capability, within the CapIOManager structure. Not yet used in this patch. - - - - - 5cf709c5 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move APPEND_TO_BLOCKED_QUEUE from cmm to C The I/O and delay blocking primitives for the non-threaded way currently access the blocked_queue and sleeping_queue directly. We want to move where those queues are to make their ownership clearer: to have them clearly belong to the I/O manager impls rather than to the scheduler. Ultimately we will want to change their representation too. It's inconvenient to do that if these queues are accessed directly from cmm code. So as a first step, replace the APPEND_TO_BLOCKED_QUEUE with a C version appendToIOBlockedQueue(), and replace the open-coded sleeping_queue insertion with insertIntoSleepingQueue(). - - - - - ced9acdb by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move {blocked,sleeping}_queue from scheduler global vars to CapIOManager The blocked_queue_{hd,tl} and the sleeping_queue are currently cooperatively managed between the scheduler and (some but not all of) the non-threaded I/O manager implementations. They lived as global vars with the scheduler, but are poked by I/O primops and the I/O manager backends. This patch is a step on the path towards making the management of I/O or timer blocking belong to the I/O managers and not the scheduler. Specifically, this patch moves the {blocked,sleeping}_queue from being global vars in the scheduler to being members of the CapIOManager struct within each Capability. They are not yet exclusively used by the I/O managers: they are still poked from a couple other places, notably in the scheduler before calling awaitEvent. - - - - - 0f68919e by Duncan Coutts at 2022-11-22T02:06:17-05:00 Remove the now-unused markScheduler The global vars {blocked,sleeping}_queue are now in the Capability and so get marked there via markCapabilityIOManager. - - - - - 39a91f60 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move macros for checking for pending IO or timers from Schedule.h to Schedule.c and IOManager.h This is just moving, the next step will be to rejig them slightly. For the non-threaded RTS the scheduler needs to be able to test for there being pending I/O operation or pending timers. The implementation of these tests should really be considered to be part of the I/O managers and not part of the scheduler. - - - - - 664b034b by Duncan Coutts at 2022-11-22T02:06:17-05:00 Replace EMPTY_{BLOCKED,SLEEPING}_QUEUE macros by function These are the macros originaly from Scheduler.h, previously moved to IOManager.h, and now replaced with a single inline function anyPendingTimeoutsOrIO(). We can use a single function since the two macros were always checked together. Note that since anyPendingTimeoutsOrIO is defined for all IO manager cases, including threaded, we do not need to guard its use by cpp #if !defined(THREADED_RTS) - - - - - 32946220 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Expand emptyThreadQueues inline for clarity It was not really adding anything. The name no longer meant anything since those I/O and timeout queues do not belong to the scheuler. In one of the two places it was used, the comments already had to explain what it did, whereas now the code matches the comment nicely. - - - - - 9943baf9 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move the awaitEvent declaration into IOManager.h And add or adjust comments at the use sites of awaitEvent. - - - - - 054dcc9d by Duncan Coutts at 2022-11-22T02:06:17-05:00 Pass the Capability *cap explicitly to awaitEvent It is currently only used in the non-threaded RTS so it works to use MainCapability, but it's a bit nicer to pass the cap anyway. It's certainly shorter. - - - - - 667fe5a4 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Pass the Capability *cap explicitly to appendToIOBlockedQueue And to insertIntoSleepingQueue. Again, it's a bit cleaner and simpler though not strictly necessary given that these primops are currently only used in the non-threaded RTS. - - - - - 7181b074 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Reveiew feedback: improve one of the TODO comments The one about the nonsense (const False) test on WinIO for there being any IO or timers pending, leading to unnecessary complication later in the scheduler. - - - - - e5b68183 by Andreas Klebinger at 2022-11-22T02:06:52-05:00 Optimize getLevity. Avoid the intermediate data structures allocated by splitTyConApp. This avoids ~0.5% of allocations for a build using -O2. Fixes #22254 - - - - - de5fb348 by Andreas Klebinger at 2022-11-22T02:07:28-05:00 hadrian:Set TNTC when running testsuite. - - - - - 9d61c182 by Oleg Grenrus at 2022-11-22T15:59:34-05:00 Add unsafePtrEquality# restricted to UnliftedTypes - - - - - e817c871 by Jonathan Dowland at 2022-11-22T16:00:14-05:00 utils/unlit: adjust parser to match Report spec The Haskell 2010 Report says that, for Latex-style Literate format, "Program code begins on the first line following a line that begins \begin{code}". (This is unchanged from the 98 Report) However the unlit.c implementation only matches a line that contains "\begin{code}" and nothing else. One consequence of this is that one cannot suffix Latex options to the code environment. I.e., this does not work: \begin{code}[label=foo,caption=Foo Code] Adjust the matcher to conform to the specification from the Report. The Haskell Wiki currently recommends suffixing a '%' to \begin{code} in order to deliberately hide a code block from Haskell. This is bad advice, as it's relying on an implementation quirk rather than specified behaviour. None-the-less, some people have tried to use it, c.f. <https://mail.haskell.org/pipermail/haskell-cafe/2009-September/066780.html> An alternative solution is to define a separate, equivalent Latex environment to "code", that is functionally identical in Latex but ignored by unlit. This should not be a burden: users are required to manually define the code environment anyway, as it is not provided by the Latex verbatim or lstlistings packages usually used for presenting code in documents. Fixes #3549. - - - - - 0b7fef11 by Teo Camarasu at 2022-11-23T12:44:33-05:00 Fix eventlog all option Previously it didn't enable/disable nonmoving_gc and ticky event types Fixes #21813 - - - - - 04d0618c by Arnaud Spiwack at 2022-11-23T12:45:14-05:00 Expand Note [Linear types] with the stance on linting linearity Per the discussion on #22123 - - - - - e1538516 by Lawton Nichols at 2022-11-23T12:45:55-05:00 Add documentation on custom Prelude modules (#22228) Specifically, custom Prelude modules that are named `Prelude`. - - - - - b5c71454 by Sylvain Henry at 2022-11-23T12:46:35-05:00 Don't let configure perform trivial substitutions (#21846) Hadrian now performs substitutions, especially to generate .cabal files from .cabal.in files. Two benefits: 1. We won't have to re-configure when we modify thing.cabal.in. Hadrian will take care of this for us. 2. It paves the way to allow the same package to be configured differently by Hadrian in the same session. This will be useful to fix #19174: we want to build a stage2 cross-compiler for the host platform and a stage1 compiler for the cross target platform in the same Hadrian session. - - - - - 99aca26b by nineonine at 2022-11-23T12:47:11-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043) Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043 - - - - - 040bfdc3 by M Farkas-Dyck at 2022-11-23T21:59:03-05:00 Scrub some no-warning pragmas. - - - - - 178c1fd8 by Vladislav Zavialov at 2022-11-23T21:59:39-05:00 Check if the SDoc starts with a single quote (#22488) This patch fixes pretty-printing of character literals inside promoted lists and tuples. When we pretty-print a promoted list or tuple whose first element starts with a single quote, we want to add a space between the opening bracket and the element: '[True] -- ok '[ 'True] -- ok '['True] -- not ok If we don't add the space, we accidentally produce a character literal '['. Before this patch, pprSpaceIfPromotedTyCon inspected the type as an AST and tried to guess if it would be rendered with a single quote. However, it missed the case when the inner type was itself a character literal: '[ 'x'] -- ok '['x'] -- not ok Instead of adding this particular case, I opted for a more future-proof solution: check the SDoc directly. This way we can detect if the single quote is actually there instead of trying to predict it from the AST. The new function is called spaceIfSingleQuote. - - - - - 11627c42 by Matthew Pickering at 2022-11-23T22:00:15-05:00 notes: Fix references to HPT space leak note Updating this note was missed when updating the HPT to the HUG. Fixes #22477 - - - - - 86ff1523 by Andrei Borzenkov at 2022-11-24T17:24:51-05:00 Convert diagnostics in GHC.Rename.Expr to proper TcRnMessage (#20115) Problem: avoid usage of TcRnMessageUnknown Solution: The following `TcRnMessage` messages has been introduced: TcRnNoRebindableSyntaxRecordDot TcRnNoFieldPunsRecordDot TcRnIllegalStaticExpression TcRnIllegalStaticFormInSplice TcRnListComprehensionDuplicateBinding TcRnEmptyStmtsGroup TcRnLastStmtNotExpr TcRnUnexpectedStatementInContext TcRnIllegalTupleSection TcRnIllegalImplicitParameterBindings TcRnSectionWithoutParentheses Co-authored-by: sheaf <sam.derbyshire at gmail.com> - - - - - d198a19a by Cheng Shao at 2022-11-24T17:25:29-05:00 rts: fix missing Arena.h symbols in RtsSymbols.c It was an unfortunate oversight in !8961 and broke devel2 builds. - - - - - 5943e739 by Bodigrim at 2022-11-25T04:38:28-05:00 Assorted fixes to avoid Data.List.{head,tail} - - - - - 1f1b99b8 by sheaf at 2022-11-25T04:38:28-05:00 Review suggestions for assorted fixes to avoid Data.List.{head,tail} - - - - - 13d627bb by Vladislav Zavialov at 2022-11-25T04:39:04-05:00 Print unticked promoted data constructors (#20531) Before this patch, GHC unconditionally printed ticks before promoted data constructors: ghci> type T = True -- unticked (user-written) ghci> :kind! T T :: Bool = 'True -- ticked (compiler output) After this patch, GHC prints ticks only when necessary: ghci> type F = False -- unticked (user-written) ghci> :kind! F F :: Bool = False -- unticked (compiler output) ghci> data False -- introduce ambiguity ghci> :kind! F F :: Bool = 'False -- ticked by necessity (compiler output) The old behavior can be enabled by -fprint-redundant-promotion-ticks. Summary of changes: * Rename PrintUnqualified to NamePprCtx * Add QueryPromotionTick to it * Consult the GlobalRdrEnv to decide whether to print a tick (see mkPromTick) * Introduce -fprint-redundant-promotion-ticks Co-authored-by: Artyom Kuznetsov <hi at wzrd.ht> - - - - - d10dc6bd by Simon Peyton Jones at 2022-11-25T22:31:27+00:00 Fix decomposition of TyConApps Ticket #22331 showed that we were being too eager to decompose a Wanted TyConApp, leading to incompleteness in the solver. To understand all this I ended up doing a substantial rewrite of the old Note [Decomposing equalities], now reborn as Note [Decomposing TyConApp equalities]. Plus rewrites of other related Notes. The actual fix is very minor and actually simplifies the code: in `can_decompose` in `GHC.Tc.Solver.Canonical.canTyConApp`, we now call `noMatchableIrreds`. A closely related refactor: we stop trying to use the same "no matchable givens" function here as in `matchClassInst`. Instead split into two much simpler functions. - - - - - 2da5c38a by Will Hawkins at 2022-11-26T04:05:04-05:00 Redirect output of musttail attribute test Compilation output from test for support of musttail attribute leaked to the console. - - - - - 0eb1c331 by Cheng Shao at 2022-11-28T08:55:53+00:00 Move hs_mulIntMayOflo cbits to ghc-prim It's only used by wasm NCG at the moment, but ghc-prim is a more reasonable place for hosting out-of-line primops. Also, we only need a single version of hs_mulIntMayOflo. - - - - - 36b53a9d by Cheng Shao at 2022-11-28T09:05:57+00:00 compiler: generate ccalls for clz/ctz/popcnt in wasm NCG We used to generate a single wasm clz/ctz/popcnt opcode, but it's wrong when it comes to subwords, so might as well generate ccalls for them. See #22470 for details. - - - - - d4134e92 by Cheng Shao at 2022-11-28T23:48:14-05:00 compiler: remove unused MO_U_MulMayOflo We actually only emit MO_S_MulMayOflo and never emit MO_U_MulMayOflo anywhere. - - - - - 8d15eadc by Apoorv Ingle at 2022-11-29T03:09:31-05:00 Killing cc_fundeps, streamlining kind equality orientation, and type equality processing order Fixes: #217093 Associated to #19415 This change * Flips the orientation of the the generated kind equality coercion in canEqLHSHetero; * Removes `cc_fundeps` in CDictCan as the check was incomplete; * Changes `canDecomposableTyConAppOk` to ensure we process kind equalities before type equalities and avoiding a call to `canEqLHSHetero` while processing wanted TyConApp equalities * Adds 2 new tests for validating the change - testsuites/typecheck/should_compile/T21703.hs and - testsuites/typecheck/should_fail/T19415b.hs (a simpler version of T19415.hs) * Misc: Due to the change in the equality direction some error messages now have flipped type mismatch errors * Changes in Notes: - Note [Fundeps with instances, and equality orientation] supercedes Note [Fundeps with instances] - Added Note [Kind Equality Orientation] to visualize the kind flipping - Added Note [Decomposing Dependent TyCons and Processing Wanted Equalties] - - - - - 646969d4 by Krzysztof Gogolewski at 2022-11-29T03:10:13-05:00 Change printing of sized literals to match the proposal Literals in Core were printed as e.g. 0xFF#16 :: Int16#. The proposal 451 now specifies syntax 0xFF#Int16. This change affects the Core printer only - more to be done later. Part of #21422. - - - - - 02e282ec by Simon Peyton Jones at 2022-11-29T03:10:48-05:00 Be a bit more selective about floating bottoming expressions This MR arranges to float a bottoming expression to the top only if it escapes a value lambda. See #22494 and Note [Floating to the top] in SetLevels. This has a generally beneficial effect in nofib +-------------------------------++----------+ | ||tsv (rel) | +===============================++==========+ | imaginary/paraffins || -0.93% | | imaginary/rfib || -0.05% | | real/fem || -0.03% | | real/fluid || -0.01% | | real/fulsom || +0.05% | | real/gamteb || -0.27% | | real/gg || -0.10% | | real/hidden || -0.01% | | real/hpg || -0.03% | | real/scs || -11.13% | | shootout/k-nucleotide || -0.01% | | shootout/n-body || -0.08% | | shootout/reverse-complement || -0.00% | | shootout/spectral-norm || -0.02% | | spectral/fibheaps || -0.20% | | spectral/hartel/fft || -1.04% | | spectral/hartel/solid || +0.33% | | spectral/hartel/wave4main || -0.35% | | spectral/mate || +0.76% | +===============================++==========+ | geom mean || -0.12% | The effect on compile time is generally slightly beneficial Metrics: compile_time/bytes allocated ---------------------------------------------- MultiLayerModulesTH_OneShot(normal) +0.3% PmSeriesG(normal) -0.2% PmSeriesT(normal) -0.1% T10421(normal) -0.1% T10421a(normal) -0.1% T10858(normal) -0.1% T11276(normal) -0.1% T11303b(normal) -0.2% T11545(normal) -0.1% T11822(normal) -0.1% T12150(optasm) -0.1% T12234(optasm) -0.3% T13035(normal) -0.2% T16190(normal) -0.1% T16875(normal) -0.4% T17836b(normal) -0.2% T17977(normal) -0.2% T17977b(normal) -0.2% T18140(normal) -0.1% T18282(normal) -0.1% T18304(normal) -0.2% T18698a(normal) -0.1% T18923(normal) -0.1% T20049(normal) -0.1% T21839r(normal) -0.1% T5837(normal) -0.4% T6048(optasm) +3.2% BAD T9198(normal) -0.2% T9630(normal) -0.1% TcPlugin_RewritePerf(normal) -0.4% hard_hole_fits(normal) -0.1% geo. mean -0.0% minimum -0.4% maximum +3.2% The T6048 outlier is hard to pin down, but it may be the effect of reading in more interface files definitions. It's a small program for which compile time is very short, so I'm not bothered about it. Metric Increase: T6048 - - - - - ab23dc5e by Ben Gamari at 2022-11-29T03:11:25-05:00 testsuite: Mark unpack_sums_6 as fragile due to #22504 This test is explicitly dependent upon runtime, which is generally not appropriate given that the testsuite is run in parallel and generally saturates the CPU. - - - - - def47dd3 by Ben Gamari at 2022-11-29T03:11:25-05:00 testsuite: Don't use grep -q in unpack_sums_7 `grep -q` closes stdin as soon as it finds the pattern it is looking for, resulting in #22484. - - - - - cc25d52e by Sylvain Henry at 2022-11-29T09:44:31+01:00 Add Javascript backend Add JS backend adapted from the GHCJS project by Luite Stegeman. Some features haven't been ported or implemented yet. Tests for these features have been disabled with an associated gitlab ticket. Bump array submodule Work funded by IOG. Co-authored-by: Jeffrey Young <jeffrey.young at iohk.io> Co-authored-by: Luite Stegeman <stegeman at gmail.com> Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 68c966cd by sheaf at 2022-11-30T09:31:25-05:00 Fix @since annotations on WithDict and Coercible Fixes #22453 - - - - - a3a8e9e9 by Simon Peyton Jones at 2022-11-30T09:32:03-05:00 Be more careful in GHC.Tc.Solver.Interact.solveOneFromTheOther We were failing to account for the cc_pend_sc flag in this important function, with the result that we expanded superclasses forever. Fixes #22516. - - - - - a9d9b8c0 by Simon Peyton Jones at 2022-11-30T09:32:03-05:00 Use mkNakedFunTy in tcPatSynSig As #22521 showed, in tcPatSynSig we make a "fake type" to kind-generalise; and that type has unzonked type variables in it. So we must not use `mkFunTy` (which checks FunTy's invariants) via `mkPhiTy` when building this type. Instead we need to use `mkNakedFunTy`. Easy fix. - - - - - 31462d98 by Andreas Klebinger at 2022-11-30T14:50:58-05:00 Properly cast values when writing/reading unboxed sums. Unboxed sums might store a Int8# value as Int64#. This patch makes sure we keep track of the actual value type. See Note [Casting slot arguments] for the details. - - - - - 10a2a7de by Oleg Grenrus at 2022-11-30T14:51:39-05:00 Move Void to GHC.Base... This change would allow `Void` to be used deeper in module graph. For example exported from `Prelude` (though that might be already possible). Also this change includes a change `stimes @Void _ x = x`, https://github.com/haskell/core-libraries-committee/issues/95 While the above is not required, maintaining old stimes behavior would be tricky as `GHC.Base` doesn't know about `Num` or `Integral`, which would require more hs-boot files. - - - - - b4cfa8e2 by Sebastian Graf at 2022-11-30T14:52:24-05:00 DmdAnal: Reflect the `seq` of strict fields of a DataCon worker (#22475) See the updated `Note [Data-con worker strictness]` and the new `Note [Demand transformer for data constructors]`. Fixes #22475. - - - - - d87f28d8 by Baldur Blöndal at 2022-11-30T21:16:36+01:00 Make Functor a quantified superclass of Bifunctor. See https://github.com/haskell/core-libraries-committee/issues/91 for discussion. This change relates Bifunctor with Functor by requiring second = fmap. Moreover this change is a step towards unblocking the major version bump of bifunctors and profunctors to major version 6. This paves the way to move the Profunctor class into base. For that Functor first similarly becomes a superclass of Profunctor in the new major version 6. - - - - - 72cf4c5d by doyougnu at 2022-12-01T12:36:44-05:00 FastString: SAT bucket_match Metric Decrease: MultiLayerModulesTH_OneShot - - - - - afc2540d by Simon Peyton Jones at 2022-12-01T12:37:20-05:00 Add a missing varToCoreExpr in etaBodyForJoinPoint This subtle bug showed up when compiling a library with 9.4. See #22491. The bug is present in master, but it is hard to trigger; the new regression test T22491 fails in 9.4. The fix was easy: just add a missing varToCoreExpr in etaBodyForJoinPoint. The fix is definitely right though! I also did some other minor refatoring: * Moved the preInlineUnconditionally test in simplExprF1 to before the call to joinPointBinding_maybe, to avoid fruitless eta-expansion. * Added a boolean from_lam flag to simplNonRecE, to avoid two fruitless tests, and commented it a bit better. These refactorings seem to save 0.1% on compile-time allocation in perf/compiler; with a max saving of 1.4% in T9961 Metric Decrease: T9961 - - - - - 81eeec7f by M Farkas-Dyck at 2022-12-01T12:37:56-05:00 CI: Forbid the fully static build on Alpine to fail. To do so, we mark some tests broken in this configuration. - - - - - c5d1bf29 by Bryan Richter at 2022-12-01T12:37:56-05:00 CI: Remove ARMv7 jobs These jobs fail (and are allowed to fail) nearly every time. Soon they won't even be able to run at all, as we won't currently have runners that can run them. Fixing the latter problem is tracked in #22409. I went ahead and removed all settings and configurations. - - - - - d82992fd by Bryan Richter at 2022-12-01T12:37:56-05:00 CI: Fix CI lint Failure was introduced by conflicting changes to gen_ci.hs that did *not* trigger git conflicts. - - - - - ce126993 by Simon Peyton Jones at 2022-12-02T01:22:12-05:00 Refactor TyCon to have a top-level product This patch changes the representation of TyCon so that it has a top-level product type, with a field that gives the details (newtype, type family etc), #22458. Not much change in allocation, but execution seems to be a bit faster. Includes a change to the haddock submodule to adjust for API changes. - - - - - 74c767df by Matthew Pickering at 2022-12-02T01:22:48-05:00 ApplicativeDo: Set pattern location before running exhaustiveness checker This improves the error messages of the exhaustiveness checker when checking statements which have been moved around with ApplicativeDo. Before: Test.hs:2:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 2 | let x = () | ^^^^^^^^^^ After: Test.hs:4:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 4 | ~(Just res1) <- seq x (pure $ Nothing @()) | Fixes #22483 - - - - - 85ecc1a0 by Matthew Pickering at 2022-12-02T19:46:43-05:00 Add special case for :Main module in `GHC.IfaceToCore.mk_top_id` See Note [Root-main Id] The `:Main` special binding is actually defined in the current module (hence don't go looking for it externally) but the module name is rOOT_MAIN rather than the current module so we need this special case. There was already some similar logic in `GHC.Rename.Env` for External Core, but now the "External Core" is in interface files it needs to be moved here instead. Fixes #22405 - - - - - 108c319f by Krzysztof Gogolewski at 2022-12-02T19:47:18-05:00 Fix linearity checking in Lint Lint was not able to see that x*y <= x*y, because this inequality was decomposed to x <= x*y && y <= x*y, but there was no rule to see that x <= x*y. Fixes #22546. - - - - - bb674262 by Bryan Richter at 2022-12-03T04:38:46-05:00 Mark T16916 fragile See https://gitlab.haskell.org/ghc/ghc/-/issues/16966 - - - - - 5d267d46 by Vladislav Zavialov at 2022-12-03T04:39:22-05:00 Refactor: FreshOrReuse instead of addTyClTyVarBinds This is a refactoring that should have no effect on observable behavior. Prior to this change, GHC.HsToCore.Quote contained a few closely related functions to process type variable bindings: addSimpleTyVarBinds, addHsTyVarBinds, addQTyVarBinds, and addTyClTyVarBinds. We can classify them by their input type and name generation strategy: Fresh names only Reuse bound names +---------------------+-------------------+ [Name] | addSimpleTyVarBinds | | [LHsTyVarBndr flag GhcRn] | addHsTyVarBinds | | LHsQTyVars GhcRn | addQTyVarBinds | addTyClTyVarBinds | +---------------------+-------------------+ Note how two functions are missing. Because of this omission, there were two places where a LHsQTyVars value was constructed just to be able to pass it to addTyClTyVarBinds: 1. mk_qtvs in addHsOuterFamEqnTyVarBinds -- bad 2. mkHsQTvs in repFamilyDecl -- bad This prevented me from making other changes to LHsQTyVars, so the main goal of this refactoring is to get rid of those workarounds. The most direct solution would be to define the missing functions. But that would lead to a certain amount of code duplication. To avoid code duplication, I factored out the name generation strategy into a function parameter: data FreshOrReuse = FreshNamesOnly | ReuseBoundNames addSimpleTyVarBinds :: FreshOrReuse -> ... addHsTyVarBinds :: FreshOrReuse -> ... addQTyVarBinds :: FreshOrReuse -> ... - - - - - c189b831 by Vladislav Zavialov at 2022-12-03T04:39:22-05:00 addHsOuterFamEqnTyVarBinds: use FreshNamesOnly for explicit binders Consider this example: [d| instance forall a. C [a] where type forall b. G [a] b = Proxy b |] When we process "forall b." in the associated type instance, it is unambiguously the binding site for "b" and we want a fresh name for it. Therefore, FreshNamesOnly is more fitting than ReuseBoundNames. This should not have any observable effect but it avoids pointless lookups in the MetaEnv. - - - - - 42512264 by Ross Paterson at 2022-12-03T10:32:45+00:00 Handle type data declarations in Template Haskell quotations and splices (fixes #22500) This adds a TypeDataD constructor to the Template Haskell Dec type, and ensures that the constructors it contains go in the TyCls namespace. - - - - - 1a767fa3 by Vladislav Zavialov at 2022-12-05T05:18:50-05:00 Add BufSpan to EpaLocation (#22319, #22558) The key part of this patch is the change to mkTokenLocation: - mkTokenLocation (RealSrcSpan r _) = TokenLoc (EpaSpan r) + mkTokenLocation (RealSrcSpan r mb) = TokenLoc (EpaSpan r mb) mkTokenLocation used to discard the BufSpan, but now it is saved and can be retrieved from LHsToken or LHsUniToken. This is made possible by the following change to EpaLocation: - data EpaLocation = EpaSpan !RealSrcSpan + data EpaLocation = EpaSpan !RealSrcSpan !(Strict.Maybe BufSpan) | ... The end goal is to make use of the BufSpan in Parser/PostProcess/Haddock. - - - - - cd31acad by sheaf at 2022-12-06T15:45:58-05:00 Hadrian: fix ghcDebugAssertions off-by-one error Commit 6b2f7ffe changed the logic that decided whether to enable debug assertions. However, it had an off-by-one error, as the stage parameter to the function inconsistently referred to the stage of the compiler being used to build or the stage of the compiler we are building. This patch makes it consistent. Now the parameter always refers to the the compiler which is being built. In particular, this patch re-enables assertions in the stage 2 compiler when building with devel2 flavour, and disables assertions in the stage 2 compiler when building with validate flavour. Some extra performance tests are now run in the "validate" jobs because the stage2 compiler no longer contains assertions. ------------------------- Metric Decrease: CoOpt_Singletons MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot T11374 T12227 T12234 T13253-spj T13701 T14683 T14697 T15703 T17096 T17516 T18304 T18478 T18923 T5030 T9872b TcPlugin_RewritePerf Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T13386 T13719 T3294 T9233 T9675 parsing001 ------------------------- - - - - - 21d66db1 by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of runInstallNameTool - - - - - aaaaa79b by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of askOtool - - - - - 4e28f49e by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of runInjectRPaths - - - - - a7422580 by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of Linker.MacOS - - - - - e902d771 by Matthew Craven at 2022-12-08T08:30:23-05:00 Fix bounds-checking buglet in Data.Array.Byte ...another manifestation of #20851 which I unfortunately missed in my first pass. - - - - - 8d36c0c6 by Gergő Érdi at 2022-12-08T08:31:03-05:00 Remove copy-pasted definitions of `graphFromEdgedVertices*` - - - - - c5d8ed3a by Gergő Érdi at 2022-12-08T08:31:03-05:00 Add version of `reachableGraph` that avoids loop for cyclic inputs by building its result connected component by component Fixes #22512 - - - - - 90cd5396 by Krzysztof Gogolewski at 2022-12-08T08:31:39-05:00 Mark Type.Reflection.Unsafe as Unsafe This module can be used to construct ill-formed TypeReps, so it should be Unsafe. - - - - - 2057c77d by Ian-Woo Kim at 2022-12-08T08:32:19-05:00 Truncate eventlog event for large payload (#20221) RTS eventlog events for postCapsetVecEvent are truncated if payload is larger than EVENT_PAYLOAD_SIZE_MAX Previously, postCapsetVecEvent records eventlog event with payload of variable size larger than EVENT_PAYLOAD_SIZE_MAX (2^16) without any validation, resulting in corrupted data. For example, this happens when a Haskell binary is invoked with very long command line arguments exceeding 2^16 bytes (see #20221). Now we check the size of accumulated payload messages incrementally, and truncate the message just before the payload size exceeds EVENT_PAYLOAD_SIZE_MAX. RTS will warn the user with a message showing how many arguments are truncated. - - - - - 9ec76f61 by Cheng Shao at 2022-12-08T08:32:59-05:00 hadrian: don't add debug info to non-debug ways of rts Hadrian used to pass -g when building all ways of rts. It makes output binaries larger (especially so for wasm backend), and isn't needed by most users out there, so this patch removes that flag. In case the debug info is desired, we still pass -g3 when building the debug way, and there's also the debug_info flavour transformer which ensures -g3 is passed for all rts ways. - - - - - 7658cdd4 by Krzysztof Gogolewski at 2022-12-08T08:33:36-05:00 Restore show (typeRep @[]) == "[]" The Show instance for TypeRep [] has changed in 9.5 to output "List" because the name of the type constructor changed. This seems to be accidental and is inconsistent with TypeReps of saturated lists, which are printed as e.g. "[Int]". For now, I'm restoring the old behavior; in the future, maybe we should show TypeReps without puns (List, Tuple, Type). - - - - - 216deefd by Matthew Pickering at 2022-12-08T22:45:27-05:00 Add test for #22162 - - - - - 5d0a311f by Matthew Pickering at 2022-12-08T22:45:27-05:00 ci: Add job to test interface file determinism guarantees In this job we can run on every commit we add a test which builds the Cabal library twice and checks that the ABI hash and interface hash is stable across the two builds. * We run the test 20 times to try to weed out any race conditions due to `-j` * We run the builds in different temporary directories to try to weed out anything related to build directory affecting ABI or interface file hash. Fixes #22180 - - - - - 0a76d7d4 by Matthew Pickering at 2022-12-08T22:45:27-05:00 ci: Add job for testing interface stability across builds The idea is that both the bindists should product libraries with the same ABI and interface hash. So the job checks with ghc-pkg to make sure the computed ABI is the same. In future this job can be extended to check for the other facets of interface determinism. Fixes #22180 - - - - - 74c9bf91 by Matthew Pickering at 2022-12-08T22:45:27-05:00 backpack: Be more careful when adding together ImportAvails There was some code in the signature merging logic which added together the ImportAvails of the signature and the signature which was merged into it. This had the side-effect of making the merged signature depend on the signature (via a normal module dependency). The intention was to propagate orphan instances through the merge but this also messed up recompilation logic because we shouldn't be attempting to load B.hi when mergeing it. The fix is to just combine the part of ImportAvails that we intended to (transitive info, orphan instances and type family instances) rather than the whole thing. - - - - - d122e022 by Matthew Pickering at 2022-12-08T22:45:27-05:00 Fix mk_mod_usage_info if the interface file is not already loaded In #22217 it was observed that the order modules are compiled in affects the contents of an interface file. This was because a module dependended on another module indirectly, via a re-export but the interface file for this module was never loaded because the symbol was never used in the file. If we decide that we depend on a module then we jolly well ought to record this fact in the interface file! Otherwise it could lead to very subtle recompilation bugs if the dependency is not tracked and the module is updated. Therefore the best thing to do is just to make sure the file is loaded by calling the `loadSysInterface` function. This first checks the caches (like we did before) but then actually goes to find the interface on disk if it wasn't loaded. Fixes #22217 - - - - - ea25088d by lrzlin at 2022-12-08T22:46:06-05:00 Add initial support for LoongArch Architecture. - - - - - 9eb9d2f4 by Bodigrim at 2022-12-08T22:46:47-05:00 Update submodule mtl to 2.3.1, parsec to 3.1.15.1, haddock and Cabal to HEAD - - - - - 08d8fe2a by Bodigrim at 2022-12-08T22:46:47-05:00 Allow mtl-2.3 in hadrian - - - - - 3807a46c by Bodigrim at 2022-12-08T22:46:47-05:00 Support mtl-2.3 in check-exact - - - - - ef702a18 by Bodigrim at 2022-12-08T22:46:47-05:00 Fix tests - - - - - 3144e8ff by Sebastian Graf at 2022-12-08T22:47:22-05:00 Make (^) INLINE (#22324) So that we get to cancel away the allocation for the lazily used base. We can move `powImpl` (which *is* strict in the base) to the top-level so that we don't duplicate too much code and move the SPECIALISATION pragmas onto `powImpl`. The net effect of this change is that `(^)` plays along much better with inlining thresholds and loopification (#22227), for example in `x2n1`. Fixes #22324. - - - - - 1d3a8b8e by Matthew Pickering at 2022-12-08T22:47:59-05:00 Typeable: Fix module locations of some definitions in GHC.Types There was some confusion in Data.Typeable about which module certain wired-in things were defined in. Just because something is wired-in doesn't mean it comes from GHC.Prim, in particular things like LiftedRep and RuntimeRep are defined in GHC.Types and that's the end of the story. Things like Int#, Float# etc are defined in GHC.Prim as they have no Haskell definition site at all so we need to generate type representations for them (which live in GHC.Types). Fixes #22510 - - - - - 0f7588b5 by Sebastian Graf at 2022-12-08T22:48:34-05:00 Make `drop` and `dropWhile` fuse (#18964) I copied the fusion framework we have in place for `take`. T18964 asserts that we regress neither when fusion fires nor when it doesn't. Fixes #18964. - - - - - 26e71562 by Sebastian Graf at 2022-12-08T22:49:10-05:00 Do not strictify a DFun's parameter dictionaries (#22549) ... thus fixing #22549. The details are in the refurbished and no longer dead `Note [Do not strictify a DFun's parameter dictionaries]`. There's a regression test in T22549. - - - - - 36093407 by John Ericson at 2022-12-08T22:49:45-05:00 Delete `rts/package.conf.in` It is a relic of the Make build system. The RTS now uses a `package.conf` file generated the usual way by Cabal. - - - - - b0cc2fcf by Krzysztof Gogolewski at 2022-12-08T22:50:21-05:00 Fixes around primitive literals * The SourceText of primitive characters 'a'# did not include the #, unlike for other primitive literals 1#, 1##, 1.0#, 1.0##, "a"#. We can now remove the function pp_st_suffix, which was a hack to add the # back. * Negative primitive literals shouldn't use parentheses, as described in Note [Printing of literals in Core]. Added a testcase to T14681. - - - - - aacf616d by Bryan Richter at 2022-12-08T22:50:56-05:00 testsuite: Mark conc024 fragile on Windows - - - - - ed239a24 by Ryan Scott at 2022-12-09T09:42:16-05:00 Document TH splices' interaction with INCOHERENT instances Top-level declaration splices can having surprising interactions with `INCOHERENT` instances, as observed in #22492. This patch resolves #22492 by documenting this strange interaction in the GHC User's Guide. [ci skip] - - - - - 1023b432 by Mike Pilgrem at 2022-12-09T09:42:56-05:00 Fix #22300 Document GHC's extensions to valid whitespace - - - - - 79b0cec0 by Luite Stegeman at 2022-12-09T09:43:38-05:00 Add support for environments that don't have setImmediate - - - - - 5b007ec5 by Luite Stegeman at 2022-12-09T09:43:38-05:00 Fix bound thread status - - - - - 65335d10 by Matthew Pickering at 2022-12-09T20:15:45-05:00 Update containers submodule This contains a fix necessary for the multi-repl to work on GHC's code base where we try to load containers and template-haskell into the same session. - - - - - 4937c0bb by Matthew Pickering at 2022-12-09T20:15:45-05:00 hadrian-multi: Put interface files in separate directories Before we were putting all the interface files in the same directory which was leading to collisions if the files were called the same thing. - - - - - 8acb5b7b by Matthew Pickering at 2022-12-09T20:15:45-05:00 hadrian-toolargs: Add filepath to allowed repl targets - - - - - 5949d927 by Matthew Pickering at 2022-12-09T20:15:45-05:00 driver: Set correct UnitId when rehydrating modules We were not setting the UnitId before rehydrating modules which just led to us attempting to find things in the wrong HPT. The test for this is the hadrian-multi command (which is now added as a CI job). Fixes #22222 - - - - - ab06c0f0 by Matthew Pickering at 2022-12-09T20:15:45-05:00 ci: Add job to test hadrian-multi command I am not sure this job is good because it requires booting HEAD with HEAD, but it should be fine. - - - - - fac3e568 by Matthew Pickering at 2022-12-09T20:16:20-05:00 hadrian: Update bootstrap plans to 9.2.* series and 9.4.* series. This updates the build plans for the most recent compiler versions, as well as fixing the hadrian-bootstrap-gen script to a specific GHC version. - - - - - 195b08b4 by Matthew Pickering at 2022-12-09T20:16:20-05:00 ci: Bump boot images to use ghc-9.4.3 Also updates the bootstrap jobs to test booting 9.2 and 9.4. - - - - - c658c580 by Matthew Pickering at 2022-12-09T20:16:20-05:00 hlint: Removed redundant UnboxedSums pragmas UnboxedSums is quite confusingly implied by UnboxedTuples, alas, just the way it is. See #22485 - - - - - b3e98a92 by Oleg Grenrus at 2022-12-11T12:26:17-05:00 Add heqT, a kind-heterogeneous variant of heq CLC proposal https://github.com/haskell/core-libraries-committee/issues/99 - - - - - bfd7c1e6 by Bodigrim at 2022-12-11T12:26:55-05:00 Document that Bifunctor instances for tuples are lawful only up to laziness - - - - - 5d1a1881 by Bryan Richter at 2022-12-12T16:22:36-05:00 Mark T21336a fragile - - - - - c30accc2 by Matthew Pickering at 2022-12-12T16:23:11-05:00 Add test for #21476 This issues seems to have been fixed since the ticket was made, so let's add a test and move on. Fixes #21476 - - - - - e9d74a3e by Sebastian Graf at 2022-12-13T22:18:39-05:00 Respect -XStrict in the pattern-match checker (#21761) We were missing a call to `decideBangHood` in the pattern-match checker. There is another call in `matchWrapper.mk_eqn_info` which seems redundant but really is not; see `Note [Desugaring -XStrict matches in Pmc]`. Fixes #21761. - - - - - 884790e2 by Gergő Érdi at 2022-12-13T22:19:14-05:00 Fix loop in the interface representation of some `Unfolding` fields As discovered in #22272, dehydration of the unfolding info of a recursive definition used to involve a traversal of the definition itself, which in turn involves traversing the unfolding info. Hence, a loop. Instead, we now store enough data in the interface that we can produce the unfolding info without this traversal. See Note [Tying the 'CoreUnfolding' knot] for details. Fixes #22272 Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 9f301189 by Alan Zimmerman at 2022-12-13T22:19:50-05:00 EPA: When splitting out header comments, keep ones for first decl Any comments immediately preceding the first declaration are no longer kept as header comments, but attach to the first declaration instead. - - - - - 8b1f1b45 by Sylvain Henry at 2022-12-13T22:20:28-05:00 JS: fix object file name comparison (#22578) - - - - - e9e161bb by Bryan Richter at 2022-12-13T22:21:03-05:00 configure: Bump min bootstrap GHC version to 9.2 - - - - - 75855643 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Don't enable TSAN in stage0 build - - - - - da7b51d8 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce blockConcat - - - - - 34f6b09c by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce MemoryOrderings - - - - - 43beaa7b by Ben Gamari at 2022-12-15T03:54:02-05:00 llvm: Respect memory specified orderings - - - - - 8faf74fc by Ben Gamari at 2022-12-15T03:54:02-05:00 Codegen/x86: Eliminate barrier for relaxed accesses - - - - - 6cc3944a by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Reduce some repetition - - - - - 6c9862c4 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Add syntax for ordered loads and stores - - - - - 748490d2 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Atomic load syntax Originally I had thought I would just use the `prim` call syntax instead of introducing new syntax for atomic loads. However, it turns out that `prim` call syntax tends to make things quite unreadable. This new syntax seems quite natural. - - - - - 28c6781a by Ben Gamari at 2022-12-15T03:54:02-05:00 codeGen: Introduce ThreadSanitizer instrumentation This introduces a new Cmm pass which instruments the program with ThreadSanitizer annotations, allowing full tracking of mutator memory accesses via TSAN. - - - - - d97aa311 by Ben Gamari at 2022-12-15T03:54:02-05:00 Hadrian: Drop TSAN_ENABLED define from flavour This is redundant since the TSANUtils.h already defines it. - - - - - 86974ef1 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Enable Cmm instrumentation in TSAN flavour - - - - - 93723290 by Ben Gamari at 2022-12-15T03:54:02-05:00 rts: Ensure that global regs are never passed as fun call args This is in general unsafe as they may be clobbered if they are mapped to caller-saved machine registers. See Note [Register parameter passing]. - - - - - 2eb0fb87 by Matthew Pickering at 2022-12-15T03:54:39-05:00 Package Imports: Get candidate packages also from re-exported modules Previously we were just looking at the direct imports to try and work out what a package qualifier could apply to but #22333 pointed out we also needed to look for reexported modules. Fixes #22333 - - - - - 552b7908 by Ben Gamari at 2022-12-15T03:55:15-05:00 compiler: Ensure that MutVar operations have necessary barriers Here we add acquire and release barriers in readMutVar# and writeMutVar#, which are necessary for soundness. Fixes #22468. - - - - - 933d61a4 by Simon Peyton Jones at 2022-12-15T03:55:51-05:00 Fix bogus test in Lint The Lint check for branch compatiblity within an axiom, in GHC.Core.Lint.compatible_branches was subtly different to the check made when contructing an axiom, in GHC.Core.FamInstEnv.compatibleBranches. The latter is correct, so I killed the former and am now using the latter. On the way I did some improvements to pretty-printing and documentation. - - - - - 03ed0b95 by Ryan Scott at 2022-12-15T03:56:26-05:00 checkValidInst: Don't expand synonyms when splitting sigma types Previously, the `checkValidInst` function (used when checking that an instance declaration is headed by an actual type class, not a type synonym) was using `tcSplitSigmaTy` to split apart the `forall`s and instance context. This is incorrect, however, as `tcSplitSigmaTy` expands type synonyms, which can cause instances headed by quantified constraint type synonyms to be accepted erroneously. This patch introduces `splitInstTyForValidity`, a variant of `tcSplitSigmaTy` specialized for validity checking that does _not_ expand type synonyms, and uses it in `checkValidInst`. Fixes #22570. - - - - - ed056bc3 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/Messages: Refactor This doesn't change behavior but makes the code a bit easier to follow. - - - - - 7356f8e0 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/ThreadPaused: Ordering fixes - - - - - 914f0025 by Ben Gamari at 2022-12-16T16:12:44-05:00 eventlog: Silence spurious data race - - - - - fbc84244 by Ben Gamari at 2022-12-16T16:12:44-05:00 Introduce SET_INFO_RELEASE for Cmm - - - - - 821b5472 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Use fences instead of explicit barriers - - - - - 2228c999 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/stm: Fix memory ordering in readTVarIO# See #22421. - - - - - 99269b9f by Ben Gamari at 2022-12-16T16:12:44-05:00 Improve heap memory barrier Note Also introduce MUT_FIELD marker in Closures.h to document mutable fields. - - - - - 70999283 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Introduce getNumCapabilities And ensure accesses to n_capabilities are atomic (although with relaxed ordering). This is necessary as RTS API callers may concurrently call into the RTS without holding a capability. - - - - - 98689f77 by Ben Gamari at 2022-12-16T16:12:44-05:00 ghc: Fix data race in dump file handling Previously the dump filename cache would use a non-atomic update which could potentially result in lost dump contents. Note that this is still a bit racy since the first writer may lag behind a later appending writer. - - - - - 605d9547 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Always use atomics for context_switch and interrupt Since these are modified by the timer handler. - - - - - 86f20258 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts/Timer: Always use atomic operations As noted in #22447, the existence of the pthread-based ITimer implementation means that we cannot assume that the program is single-threaded. - - - - - f8e901dc by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate recent_activity access This makes it easier to ensure that it is accessed using the necessary atomic operations. - - - - - e0affaa9 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate access to capabilities array - - - - - 7ca683e4 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate sched_state - - - - - 1cf13bd0 by Ben Gamari at 2022-12-16T16:12:45-05:00 PrimOps: Fix benign MutVar race Relaxed ordering is fine here since the later CAS implies a release. - - - - - 3d2a7e08 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Style fix - - - - - 82c62074 by Ben Gamari at 2022-12-16T16:12:45-05:00 compiler: Use release store in eager blackholing - - - - - eb1a0136 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Fix ordering of makeStableName - - - - - ad0e260a by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Use ordered accesses instead of explicit barriers - - - - - a3eccf06 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Statically allocate capabilities This is a rather simplistic way of solving #17289. - - - - - 287fa3fb by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Ensure that all accesses to pending_sync are atomic - - - - - 351eae58 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Note race with wakeBlockingQueue - - - - - 5acf33dd by Bodigrim at 2022-12-16T16:13:22-05:00 Bump submodule directory to 1.3.8.0 and hpc to HEAD - - - - - 0dd95421 by Bodigrim at 2022-12-16T16:13:22-05:00 Accept allocations increase on Windows This is because of `filepath-1.4.100.0` and AFPP, causing increasing round-trips between lists and ByteArray. See #22625 for discussion. Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T10547 T12150 T12227 T12234 T12425 T13035 T13253 T13253-spj T13701 T13719 T15703 T16875 T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T21839r T5837 T6048 T9198 T9961 TcPlugin_RewritePerf hard_hole_fits - - - - - ef9ac9d2 by Cheng Shao at 2022-12-16T16:13:59-05:00 testsuite: Mark T9405 as fragile instead of broken on Windows It's starting to pass again, and the unexpected pass blocks CI. - - - - - 1f3abd85 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: remove obsolete commented code in wasm NCG It was just a temporary hack to workaround a bug in the relooper, that bug has been fixed long before the wasm backend is merged. - - - - - e3104eab by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add missing export list of GHC.CmmToAsm.Wasm.FromCmm Also removes some unreachable code here. - - - - - 1c6930bf by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: change fallback function signature to Cmm function signature in wasm NCG In the wasm NCG, when handling a `CLabel` of undefined function without knowing its function signature, we used to fallback to `() -> ()` which is accepted by `wasm-ld`. This patch changes it to the signature of Cmm functions, which equally works, but would be required when we emit tail call instructions. - - - - - 8a81d9d9 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add optional tail-call support in wasm NCG When the `-mtail-call` clang flag is passed at configure time, wasm tail-call extension is enabled, and the wasm NCG will emit `return_call`/`return_call_indirect` instructions to take advantage of it and avoid the `StgRun` trampoline overhead. Closes #22461. - - - - - d1431cc0 by Cheng Shao at 2022-12-17T08:07:15-05:00 base: add missing autoconf checks for waitpid/umask These are not present in wasi-libc. Required for fixing #22589 - - - - - da3f1e91 by Cheng Shao at 2022-12-17T08:07:51-05:00 compiler: make .wasm the default executable extension on wasm32 Following convention as in other wasm toolchains. Fixes #22594. - - - - - ad21f4ef by Cheng Shao at 2022-12-17T08:07:51-05:00 ci: support hello.wasm in ci.sh cross testing logic - - - - - 6fe2d778 by amesgen at 2022-12-18T19:33:49-05:00 Correct `exitWith` Haddocks The `IOError`-specific `catch` in the Prelude is long gone. - - - - - b3eacd64 by Ben Gamari at 2022-12-18T19:34:24-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 761c1f49 by Ben Gamari at 2022-12-18T19:35:00-05:00 rts/libdw: Silence uninitialized usage warnings As noted in #22538, previously some GCC versions warned that various locals in Libdw.c may be used uninitialized. Although this wasn't strictly true (since they were initialized in an inline assembler block) we fix this by providing explicit empty initializers. Fixes #22538 - - - - - 5e047eff by Matthew Pickering at 2022-12-20T15:12:04+00:00 testsuite: Mark T16392 as fragile on windows See #22649 - - - - - 703a4665 by M Farkas-Dyck at 2022-12-20T21:14:46-05:00 Scrub some partiality in `GHC.Cmm.Info.Build`: `doSRTs` takes a `[(CAFSet, CmmDecl)]` but truly wants a `[(CAFSet, CmmStatics)]`. - - - - - 9736ab74 by Matthew Pickering at 2022-12-20T21:15:22-05:00 packaging: Fix upload_ghc_libs.py script This change reflects the changes where .cabal files are now generated by hadrian rather than ./configure. Fixes #22518 - - - - - 7c6de18d by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Drop uses of AC_PROG_CC_C99 As noted in #22566, this macro is deprecated as of autoconf-2.70 `AC_PROG_CC` now sets `ac_cv_prog_cc_c99` itself. Closes #22566. - - - - - 36c5d98e by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Use AS_HELP_STRING instead of AC_HELP_STRING The latter has been deprecated. See #22566. - - - - - befe6ff8 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: fix various usages of head and tail - - - - - 666d0ba7 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: avoid head and tail in parseCallEscape and around - - - - - 5d96fd50 by Bodigrim at 2022-12-20T21:16:37-05:00 Make GHC.Driver.Main.hscTcRnLookupRdrName to return NonEmpty - - - - - 3ce2ab94 by Bodigrim at 2022-12-21T06:17:56-05:00 Allow transformers-0.6 in ghc, ghci, ghc-bin and hadrian - - - - - 954de93a by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule haskeline to HEAD (to allow transformers-0.6) - - - - - cefbeec3 by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule transformers to 0.6.0.4 - - - - - b4730b62 by Bodigrim at 2022-12-21T06:17:56-05:00 Fix tests T13253 imports MonadTrans, which acquired a quantified constraint in transformers-0.6, thus increase in allocations Metric Increase: T13253 - - - - - 0be75261 by Simon Peyton Jones at 2022-12-21T06:18:32-05:00 Abstract over the right free vars Fix #22459, in two ways: (1) Make the Specialiser not create a bogus specialisation if it is presented by strangely polymorphic dictionary. See Note [Weird special case in SpecDict] in GHC.Core.Opt.Specialise (2) Be more careful in abstractFloats See Note [Which type variables to abstract over] in GHC.Core.Opt.Simplify.Utils. So (2) stops creating the excessively polymorphic dictionary in abstractFloats, while (1) stops crashing if some other pass should nevertheless create a weirdly polymorphic dictionary. - - - - - df7bc6b3 by Ying-Ruei Liang (TheKK) at 2022-12-21T14:31:54-05:00 rts: explicitly store return value of ccall checkClosure to prevent type error (#22617) - - - - - e193e537 by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. - - - - - 3d55d8ab by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 - - - - - ceb2e9b9 by Ben Gamari at 2022-12-21T15:26:08-05:00 configure: Bump version to 9.6 - - - - - fb4d36c4 by Ben Gamari at 2022-12-21T15:27:49-05:00 base: Bump version to 4.18 Requires various submodule bumps. - - - - - 93ee7e90 by Ben Gamari at 2022-12-21T15:27:49-05:00 ghc-boot: Fix bootstrapping - - - - - fc3a2232 by Ben Gamari at 2022-12-22T13:45:06-05:00 Bump GHC version to 9.7 - - - - - 914f7fe3 by Andreas Klebinger at 2022-12-22T23:36:10-05:00 Don't consider large byte arrays/compact regions pinned. Workaround for #22255 which showed how treating large/compact regions as pinned could cause segfaults. - - - - - 32b32d7f by Matthew Pickering at 2022-12-22T23:36:46-05:00 hadrian bindist: Install manpages to share/man/man1/ghc.1 When the installation makefile was copied over the manpages were no longer installed in the correct place. Now we install it into share/man/man1/ghc.1 as the make build system did. Fixes #22371 - - - - - b3ddf803 by Ben Gamari at 2022-12-22T23:37:23-05:00 rts: Drop paths from configure from cabal file A long time ago we would rely on substitutions from the configure script to inject paths of the include and library directories of libffi and libdw. However, now these are instead handled inside Hadrian when calling Cabal's `configure` (see the uses of `cabalExtraDirs` in Hadrian's `Settings.Packages.packageArgs`). While the occurrences in the cabal file were redundant, they did no harm. However, since b5c714545abc5f75a1ffdcc39b4bfdc7cd5e64b4 they have no longer been interpolated. @mpickering noticed the suspicious uninterpolated occurrence of `@FFIIncludeDir@` in #22595, prompting this commit to finally remove them. - - - - - b2c7523d by Ben Gamari at 2022-12-22T23:37:59-05:00 Bump libffi-tarballs submodule We will now use libffi-3.4.4. - - - - - 3699a554 by Alan Zimmerman at 2022-12-22T23:38:35-05:00 EPA: Make EOF position part of AnnsModule Closes #20951 Closes #19697 - - - - - 99757ce8 by Sylvain Henry at 2022-12-22T23:39:13-05:00 JS: fix support for -outputdir (#22641) The `-outputdir` option wasn't correctly handled with the JS backend because the same code path was used to handle both objects produced by the JS backend and foreign .js files. Now we clearly distinguish the two in the pipeline, fixing the bug. - - - - - 02ed7d78 by Simon Peyton Jones at 2022-12-22T23:39:49-05:00 Refactor mkRuntimeError This patch fixes #22634. Because we don't have TYPE/CONSTRAINT polymorphism, we need two error functions rather than one. I took the opportunity to rname runtimeError to impossibleError, to line up with mkImpossibleExpr, and avoid confusion with the genuine runtime-error-constructing functions. - - - - - 35267f07 by Ben Gamari at 2022-12-22T23:40:32-05:00 base: Fix event manager shutdown race on non-Linux platforms During shutdown it's possible that we will attempt to use a closed fd to wakeup another capability's event manager. On the Linux eventfd path we were careful to handle this. However on the non-Linux path we failed to do so. Fix this. - - - - - 317f45c1 by Simon Peyton Jones at 2022-12-22T23:41:07-05:00 Fix unifier bug: failing to decompose over-saturated type family This simple patch fixes #22647 - - - - - 14b2e3d3 by Ben Gamari at 2022-12-22T23:41:42-05:00 rts/m32: Fix sanity checking Previously we would attempt to clear pages which were marked as read-only. Fix this. - - - - - 16a1bcd1 by Matthew Pickering at 2022-12-23T09:15:24+00:00 ci: Move wasm pipelines into nightly rather than master See #22664 for the changes which need to be made to bring one of these back to the validate pipeline. - - - - - 18d2acd2 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in marking of blackholes We must use an acquire-fence when marking to ensure that the indirectee is visible. - - - - - 11241efa by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix segment list races - - - - - 602455c9 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Use atomic when looking at bd->gen Since it may have been mutated by a moving GC. - - - - - 9d63b160 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Eliminate race in bump_static_flag To ensure that we don't race with a mutator entering a new CAF we take the SM mutex before touching static_flag. The other option here would be to instead modify newCAF to use a CAS but the present approach is a bit safer. - - - - - 26837523 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that mutable fields have acquire barrier - - - - - 8093264a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix races in collector status tracking Mark a number of accesses to do with tracking of the status of the concurrent collection thread as atomic. No interesting races here, merely necessary to satisfy TSAN. - - - - - 387d4fcc by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make segment state updates atomic - - - - - 543cae00 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Refactor update remembered set initialization This avoids a lock inversion between the storage manager mutex and the stable pointer table mutex by not dropping the SM_MUTEX in nonmovingCollect. This requires quite a bit of rejiggering but it does seem like a better strategy. - - - - - c9936718 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that we aren't holding locks when closing them TSAN complains about this sort of thing. - - - - - 0cd31f7d by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make bitmap accesses atomic This is a benign race on any sensible hard since these are byte accesses. Nevertheless, atomic accesses are necessary to satisfy TSAN. - - - - - d3fe110a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix benign race in update remembered set check Relaxed load is fine here since we will take the lock before looking at the list. - - - - - ab6cf893 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in shortcutting We must use an acquire load to read the info table pointer since if we find an indirection we must be certain that we see the indirectee. - - - - - 36c9f23c by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make free list counter accesses atomic Since these may race with the allocator(s). - - - - - aebef31c by doyougnu at 2022-12-23T19:10:09-05:00 add GHC.Utils.Binary.foldGet' and use for Iface A minor optimization to remove lazy IO and a lazy accumulator strictify foldGet' IFace.Binary: use strict foldGet' remove superfluous bang - - - - - 5eb357d9 by Ben Gamari at 2022-12-24T00:41:05-05:00 compiler: Ensure that GHC toolchain is first in search path As noted in #22561, it is important that GHC's toolchain look first for its own headers and libraries to ensure that the system's are not found instead. If this happens things can break in surprising ways (e.g. see #22561). - - - - - cbaebfb9 by Matthew Pickering at 2022-12-24T00:41:40-05:00 head.hackage: Use slow-validate bindist for linting jobs This enables the SLOW_VALIDATE env var for the linting head.hackage jobs, namely the jobs enabled manually, by the label or on the nightly build now use the deb10-numa-slow-validate bindist which has assertions enabled. See #22623 for a ticket which was found by using this configuration already! The head.hackage jobs triggered by upstream CI are now thusly: hackage-lint: Can be triggered on any MR, normal validate pipeline or nightly build. Runs head.hackage with -dlint and a slow-validate bindist hackage-label-lint: Trigged on MRs with "user-facing" label, runs the slow-validate head.hackage build with -dlint. nightly-hackage-lint: Runs automatically on nightly pipelines with slow-validate + dlint config. nightly-hackage-perf: Runs automaticaly on nightly pipelines with release build and eventlogging enabled. release-hackage-lint: Runs automatically on release pipelines with -dlint on a release bindist. - - - - - f4850f36 by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Don't run abi-test-nightly on release jobs The test is not configured to get the correct dependencies for the release pipelines (and indeed stops the release pipeline being run at all) - - - - - c264b06b by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Run head.hackage jobs on upstream-testing branch rather than master This change allows less priviledged users to trigger head.hackage jobs because less permissions are needed to trigger jobs on the upstream-testing branch, which is not protected. There is a CI job which updates upstream-testing each hour to the state of the master branch so it should always be relatively up-to-date. - - - - - 63b97430 by Ben Gamari at 2022-12-24T00:42:16-05:00 llvmGen: Fix relaxed ordering Previously I used LLVM's `unordered` ordering for the C11 `relaxed` ordering. However, this is wrong and should rather use the LLVM `monotonic` ordering. Fixes #22640 - - - - - f42ba88f by Ben Gamari at 2022-12-24T00:42:16-05:00 gitlab-ci: Introduce aarch64-linux-llvm job This nightly job will ensure that we don't break the LLVM backend on AArch64/Linux by bootstrapping GHC. This would have caught #22640. - - - - - 6d62f6bf by Matthew Pickering at 2022-12-24T00:42:51-05:00 Store RdrName rather than OccName in Holes In #20472 it was pointed out that you couldn't defer out of scope but the implementation collapsed a RdrName into an OccName to stuff it into a Hole. This leads to the error message for a deferred qualified name dropping the qualification which affects the quality of the error message. This commit adds a bit more structure to a hole, so a hole can replace a RdrName without losing information about what that RdrName was. This is important when printing error messages. I also added a test which checks the Template Haskell deferral of out of scope qualified names works properly. Fixes #22130 - - - - - 3c3060e4 by Richard Eisenberg at 2022-12-24T17:34:19+00:00 Drop support for kind constraints. This implements proposal 547 and closes ticket #22298. See the proposal and ticket for motivation. Compiler perf improves a bit Metrics: compile_time/bytes allocated ------------------------------------- CoOpt_Singletons(normal) -2.4% GOOD T12545(normal) +1.0% T13035(normal) -13.5% GOOD T18478(normal) +0.9% T9872d(normal) -2.2% GOOD geo. mean -0.2% minimum -13.5% maximum +1.0% Metric Decrease: CoOpt_Singletons T13035 T9872d - - - - - 6d7d4393 by Ben Gamari at 2022-12-24T21:09:56-05:00 hadrian: Ensure that linker scripts are used when merging objects In #22527 @rui314 inadvertantly pointed out a glaring bug in Hadrian's implementation of the object merging rules: unlike the old `make` build system we utterly failed to pass the needed linker scripts. Fix this. - - - - - a5bd0eb8 by Bodigrim at 2022-12-24T21:10:34-05:00 Document infelicities of instance Ord Double and workarounds - - - - - 62b9a7b2 by Zubin Duggal at 2023-01-03T12:22:11+00:00 Force the Docs structure to prevent leaks in GHCi with -haddock without -fwrite-interface Involves adding many new NFData instances. Without forcing Docs, references to the TcGblEnv for each module are retained by the Docs structure. Usually these are forced when the ModIface is serialised but not when we aren't writing the interface. - - - - - 21bedd84 by Facundo Domínguez at 2023-01-03T23:27:30-05:00 Explain the auxiliary functions of permutations - - - - - 32255d05 by Matthew Pickering at 2023-01-04T11:58:42+00:00 compiler: Add -f[no-]split-sections flags Here we add a `-fsplit-sections` flag which may some day replace `-split-sections`. This has the advantage of automatically providing a `-fno-split-sections` flag, which is useful for our packaging because we enable `-split-sections` by default but want to disable it in certain configurations. - - - - - e640940c by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Fix computation of tables_next_to_code for outOfTreeCompiler This copy-pasto was introduced in de5fb3489f2a9bd6dc75d0cb8925a27fe9b9084b - - - - - 15bee123 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add test:all_deps to build just testsuite dependencies Fixes #22534 - - - - - fec6638e by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add no_split_sections tranformer This transformer reverts the effect of `split_sections`, which we intend to use for platforms which don't support split sections. In order to achieve this we have to modify the implemntation of the split_sections transformer to store whether we are enabling split_sections directly in the `Flavour` definition. This is because otherwise there's no convenient way to turn off split_sections due to having to pass additional linker scripts when merging objects. - - - - - 3dc05726 by Matthew Pickering at 2023-01-04T11:58:42+00:00 check-exact: Fix build with -Werror - - - - - 53a6ae7a by Matthew Pickering at 2023-01-04T11:58:42+00:00 ci: Build all test dependencies with in-tree compiler This means that these executables will honour flavour transformers such as "werror". Fixes #22555 - - - - - 32e264c1 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Document using GHC environment variable to select boot compiler Fixes #22340 - - - - - be9dd9b0 by Matthew Pickering at 2023-01-04T11:58:42+00:00 packaging: Build perf builds with -split-sections In 8f71d958 the make build system was made to use split-sections on linux systems but it appears this logic never made it to hadrian. There is the split_sections flavour transformer but this doesn't appear to be used for perf builds on linux. This is disbled on deb9 and windows due to #21670 Closes #21135 - - - - - 00dc5106 by Matthew Pickering at 2023-01-04T14:32:45-05:00 sphinx: Use modern syntax for extlinks This fixes the following build error: ``` Command line: /opt/homebrew/opt/sphinx-doc/bin/sphinx-build -b man -d /private/tmp/extra-dir-55768274273/.doctrees-man -n -w /private/tmp/extra-dir-55768274273/.log docs/users_guide /private/tmp/extra-dir-55768274273 ===> Command failed with error code: 2 Exception occurred: File "/opt/homebrew/Cellar/sphinx-doc/6.0.0/libexec/lib/python3.11/site-packages/sphinx/ext/extlinks.py", line 101, in role title = caption % part ~~~~~~~~^~~~~~ TypeError: not all arguments converted during string formatting ``` I tested on Sphinx-5.1.1 and Sphinx-6.0.0 Thanks for sterni for providing instructions about how to test using sphinx-6.0.0. Fixes #22690 - - - - - 541aedcd by Krzysztof Gogolewski at 2023-01-05T10:48:34-05:00 Misc cleanup - Remove unused uniques and hs-boot declarations - Fix types of seq and unsafeCoerce# - Remove FastString/String roundtrip in JS - Use TTG to enforce totality - Remove enumeration in Heap/Inspect; the 'otherwise' clause serves the primitive types well. - - - - - 22bb8998 by Alan Zimmerman at 2023-01-05T10:49:09-05:00 EPA: Do not collect comments from end of file In Parser.y semis1 production triggers for the virtual semi at the end of the file. This is detected by it being zero length. In this case, do not extend the span being used to gather comments, so any final comments are allocated at the module level instead. - - - - - 9e077999 by Vladislav Zavialov at 2023-01-05T23:01:55-05:00 HsToken in TypeArg (#19623) Updates the haddock submodule. - - - - - b2a2db04 by Matthew Pickering at 2023-01-05T23:02:30-05:00 Revert "configure: Drop uses of AC_PROG_CC_C99" This reverts commit 7c6de18dd3151ead954c210336728e8686c91de6. Centos7 using a very old version of the toolchain (autotools-2.69) where the behaviour of these macros has not yet changed. I am reverting this without haste as it is blocking the 9.6 branch. Fixes #22704 - - - - - 28f8c0eb by Luite Stegeman at 2023-01-06T18:16:24+09:00 Add support for sized literals in the bytecode interpreter. The bytecode interpreter only has branching instructions for word-sized values. These are used for pattern matching. Branching instructions for other types (e.g. Int16# or Word8#) weren't needed, since unoptimized Core or STG never requires branching on types like this. It's now possible for optimized STG to reach the bytecode generator (e.g. fat interface files or certain compiler flag combinations), which requires dealing with various sized literals in branches. This patch improves support for generating bytecode from optimized STG by adding the following new bytecode instructions: TESTLT_I64 TESTEQ_I64 TESTLT_I32 TESTEQ_I32 TESTLT_I16 TESTEQ_I16 TESTLT_I8 TESTEQ_I8 TESTLT_W64 TESTEQ_W64 TESTLT_W32 TESTEQ_W32 TESTLT_W16 TESTEQ_W16 TESTLT_W8 TESTEQ_W8 Fixes #21945 - - - - - ac39e8e9 by Matthew Pickering at 2023-01-06T13:47:00-05:00 Only store Name in FunRhs rather than Id with knot-tied fields All the issues here have been caused by #18758. The goal of the ticket is to be able to talk about things like `LTyClDecl GhcTc`. In the case of HsMatchContext, the correct "context" is whatever we want, and in fact storing just a `Name` is sufficient and correct context, even if the rest of the AST is storing typechecker Ids. So this reverts (#20415, !5579) which intended to get closed to #18758 but didn't really and introduced a few subtle bugs. Printing of an error message in #22695 would just hang, because we would attempt to print the `Id` in debug mode to assertain whether it was empty or not. Printing the Name is fine for the error message. Another consequence is that when `-dppr-debug` was enabled the compiler would hang because the debug printing of the Id would try and print fields which were not populated yet. This also led to 32070e6c2e1b4b7c32530a9566fe14543791f9a6 having to add a workaround for the `checkArgs` function which was probably a very similar bug to #22695. Fixes #22695 - - - - - c306d939 by Matthew Pickering at 2023-01-06T22:08:53-05:00 ci: Upgrade darwin, windows and freebsd CI to use GHC-9.4.3 Fixes #22599 - - - - - 0db496ff by Matthew Pickering at 2023-01-06T22:08:53-05:00 darwin ci: Explicitly pass desired build triple to configure On the zw3rk machines for some reason the build machine was inferred to be arm64. Setting the build triple appropiately resolve this confusion and we produce x86 binaries. - - - - - 2459c358 by Ben Gamari at 2023-01-06T22:09:29-05:00 rts: MUT_VAR is not a StgMutArrPtrs There was previously a comment claiming that the MUT_VAR closure type had the layout of StgMutArrPtrs. - - - - - 6206cb92 by Simon Peyton Jones at 2023-01-07T12:14:40-05:00 Make FloatIn robust to shadowing This MR fixes #22622. See the new Note [Shadowing and name capture] I did a bit of refactoring in sepBindsByDropPoint too. The bug doesn't manifest in HEAD, but it did show up in 9.4, so we should backport this patch to 9.4 - - - - - a960ca81 by Matthew Pickering at 2023-01-07T12:15:15-05:00 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s - - - - - 73484710 by Matthew Pickering at 2023-01-07T12:15:15-05:00 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. - - - - - 8c0ea25f by Matthew Pickering at 2023-01-07T12:15:15-05:00 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes - - - - - 365b3045 by Matthew Pickering at 2023-01-09T02:36:20-05:00 Disable split sections on aarch64-deb10 build See #22722 Failure on this job: https://gitlab.haskell.org/ghc/ghc/-/jobs/1287852 ``` Unexpected failures: /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T10828.run T10828 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T13123.run T13123 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T20590.run T20590 [exit code non-0] (ext-interp) Appending 232 stats to file: /builds/ghc/ghc/performance-metrics.tsv ``` ``` Compile failed (exit code 1) errors were: data family D_0 a_1 :: * -> * data instance D_0 GHC.Types.Int GHC.Types.Bool :: * where DInt_2 :: D_0 GHC.Types.Int GHC.Types.Bool data E_3 where MkE_4 :: a_5 -> E_3 data Foo_6 a_7 b_8 where MkFoo_9, MkFoo'_10 :: a_11 -> Foo_6 a_11 b_12 newtype Bar_13 :: * -> GHC.Types.Bool -> * where MkBar_14 :: a_15 -> Bar_13 a_15 b_16 data T10828.T (a_0 :: *) where T10828.MkT :: forall (a_1 :: *) . a_1 -> a_1 -> T10828.T a_1 T10828.MkC :: forall (a_2 :: *) (b_3 :: *) . (GHC.Types.~) a_2 GHC.Types.Int => {T10828.foo :: a_2, T10828.bar :: b_3} -> T10828.T GHC.Types.Int T10828.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: (do TyConI dec <- runQ $ reify (mkName "T") runIO $ putStrLn (pprint dec) >> hFlush stdout d <- runQ $ [d| data T' a :: Type where MkT' :: a -> a -> T' a MkC' :: forall a b. (a ~ Int) => {foo :: a, bar :: b} -> T' Int |] runIO $ putStrLn (pprint d) >> hFlush stdout ....) *** unexpected failure for T10828(ext-interp) =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] Compile failed (exit code 1) errors were: T13123.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data GADT where MkGADT :: forall k proxy (a :: k). proxy a -> GADT |]) *** unexpected failure for T13123(ext-interp) =====> 7100 of 9215 [0, 2, 0] =====> 7100 of 9215 [0, 2, 0] =====> 7200 of 9215 [0, 2, 0] Compile failed (exit code 1) errors were: T20590.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data T where MkT :: forall a. a -> T |]) *** unexpected failure for T20590(ext-interp) ``` Looks fairly worrying to me. - - - - - 965a2735 by Alan Zimmerman at 2023-01-09T02:36:20-05:00 EPA: exact print HsDocTy To match ghc-exactprint https://github.com/alanz/ghc-exactprint/pull/121 - - - - - 5d65773e by John Ericson at 2023-01-09T20:39:27-05:00 Remove RTS hack for configuring See the brand new Note [Undefined symbols in the RTS] for additional details. - - - - - e3fff751 by Sebastian Graf at 2023-01-09T20:40:02-05:00 Handle shadowing in DmdAnal (#22718) Previously, when we had a shadowing situation like ```hs f x = ... -- demand signature <1L><1L> main = ... \f -> f 1 ... ``` we'd happily use the shadowed demand signature at the call site inside the lambda. Of course, that's wrong and solution is simply to remove the demand signature from the `AnalEnv` when we enter the lambda. This patch does so for all binding constructs Core. In #22718 the issue was caused by LetUp not shadowing away the existing demand signature for the let binder in the let body. The resulting absent error is fickle to reproduce; hence no reproduction test case. #17478 would help. Fixes #22718. It appears that TcPlugin_Rewrite regresses by ~40% on Darwin. It is likely that DmdAnal was exploiting ill-scoped analysis results. Metric increase ['bytes allocated'] (test_env=x86_64-darwin-validate): TcPlugin_Rewrite - - - - - d53f6f4d by Oleg Grenrus at 2023-01-09T21:11:02-05:00 Add safe list indexing operator: !? With Joachim's amendments. Implements https://github.com/haskell/core-libraries-committee/issues/110 - - - - - cfaf1ad7 by Nicolas Trangez at 2023-01-09T21:11:03-05:00 rts, tests: limit thread name length to 15 bytes On Linux, `pthread_setname_np` (or rather, the kernel) only allows for thread names up to 16 bytes, including the terminating null byte. This commit adds a note pointing this out in `createOSThread`, and fixes up two instances where a thread name of more than 15 characters long was used (in the RTS, and in a test-case). Fixes: #22366 Fixes: https://gitlab.haskell.org/ghc/ghc/-/issues/22366 See: https://gitlab.haskell.org/ghc/ghc/-/issues/22366#note_460796 - - - - - 64286132 by Matthew Pickering at 2023-01-09T21:11:03-05:00 Store bootstrap_llvm_target and use it to set LlvmTarget in bindists This mirrors some existing logic for the bootstrap_target which influences how TargetPlatform is set. As described on #21970 not storing this led to `LlvmTarget` being set incorrectly and hence the wrong `--target` flag being passed to the C compiler. Towards #21970 - - - - - 4724e8d1 by Matthew Pickering at 2023-01-09T21:11:04-05:00 Check for FP_LD_NO_FIXUP_CHAINS in installation configure script Otherwise, when installing from a bindist the C flag isn't passed to the C compiler. This completes the fix for #22429 - - - - - 2e926b88 by Georgi Lyubenov at 2023-01-09T21:11:07-05:00 Fix outdated link to Happy section on sequences - - - - - 146a1458 by Matthew Pickering at 2023-01-09T21:11:07-05:00 Revert "NCG(x86): Compile add+shift as lea if possible." This reverts commit 20457d775885d6c3df020d204da9a7acfb3c2e5a. See #22666 and #21777 - - - - - 6e6adbe3 by Jade Lovelace at 2023-01-11T00:55:30-05:00 Fix tcPluginRewrite example - - - - - faa57138 by Jade Lovelace at 2023-01-11T00:55:31-05:00 fix missing haddock pipe - - - - - 0470ea7c by Florian Weimer at 2023-01-11T00:56:10-05:00 m4/fp_leading_underscore.m4: Avoid implicit exit function declaration And switch to a new-style function definition. Fixes build issues with compilers that do not accept implicit function declarations. - - - - - b2857df4 by HaskellMouse at 2023-01-11T00:56:52-05:00 Added a new warning about compatibility with RequiredTypeArguments This commit introduces a new warning that indicates code incompatible with future extension: RequiredTypeArguments. Enabling this extension may break some code and the warning will help to make it compatible in advance. - - - - - 5f17e21a by Ben Gamari at 2023-01-11T00:57:27-05:00 testsuite: Drop testheapalloced.c As noted in #22414, this file (which appears to be a benchmark for characterising the one-step allocator's MBlock cache) is currently unreferenced. Remove it. Closes #22414. - - - - - bc125775 by Vladislav Zavialov at 2023-01-11T00:58:03-05:00 Introduce the TypeAbstractions language flag GHC Proposals #448 "Modern scoped type variables" and #425 "Invisible binders in type declarations" introduce a new language extension flag: TypeAbstractions. Part of the functionality guarded by this flag has already been implemented, namely type abstractions in constructor patterns, but it was guarded by a combination of TypeApplications and ScopedTypeVariables instead of a dedicated language extension flag. This patch does the following: * introduces a new language extension flag TypeAbstractions * requires TypeAbstractions for @a-syntax in constructor patterns instead of TypeApplications and ScopedTypeVariables * creates a User's Guide page for TypeAbstractions and moves the "Type Applications in Patterns" section there To avoid a breaking change, the new flag is implied by ScopedTypeVariables and is retroactively added to GHC2021. Metric Decrease: MultiLayerModulesTH_OneShot - - - - - 083f7015 by Krzysztof Gogolewski at 2023-01-11T00:58:38-05:00 Misc cleanup - Remove unused mkWildEvBinder - Use typeTypeOrConstraint - more symmetric and asserts that that the type is Type or Constraint - Fix escape sequences in Python; they raise a deprecation warning with -Wdefault - - - - - aed1974e by Richard Eisenberg at 2023-01-11T08:30:42+00:00 Refactor the treatment of loopy superclass dicts This patch completely re-engineers how we deal with loopy superclass dictionaries in instance declarations. It fixes #20666 and #19690 The highlights are * Recognise that the loopy-superclass business should use precisely the Paterson conditions. This is much much nicer. See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance * With that in mind, define "Paterson-smaller" in Note [Paterson conditions] in GHC.Tc.Validity, and the new data type `PatersonSize` in GHC.Tc.Utils.TcType, along with functions to compute and compare PatsonSizes * Use the new PatersonSize stuff when solving superclass constraints See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance * In GHC.Tc.Solver.Monad.lookupInInerts, add a missing call to prohibitedSuperClassSolve. This was the original cause of #20666. * Treat (TypeError "stuff") as having PatersonSize zero. See Note [Paterson size for type family applications] in GHC.Tc.Utils.TcType. * Treat the head of a Wanted quantified constraint in the same way as the superclass of an instance decl; this is what fixes #19690. See GHC.Tc.Solver.Canonical Note [Solving a Wanted forall-constraint] (Thanks to Matthew Craven for this insight.) This entailed refactoring the GivenSc constructor of CtOrigin a bit, to say whether it comes from an instance decl or quantified constraint. * Some refactoring way in which redundant constraints are reported; we don't want to complain about the extra, apparently-redundant constraints that we must add to an instance decl because of the loopy-superclass thing. I moved some work from GHC.Tc.Errors to GHC.Tc.Solver. * Add a new section to the user manual to describe the loopy superclass issue and what rules it follows. - - - - - 300bcc15 by HaskellMouse at 2023-01-11T13:43:36-05:00 Parse qualified terms in type signatures This commit allows qualified terms in type signatures to pass the parser and to be cathced by renamer with more informative error message. Adds a few tests. Fixes #21605 - - - - - 964284fc by Simon Peyton Jones at 2023-01-11T13:44:12-05:00 Fix void-arg-adding mechanism for worker/wrapper As #22725 shows, in worker/wrapper we must add the void argument /last/, not first. See GHC.Core.Opt.WorkWrap.Utils Note [Worker/wrapper needs to add void arg last]. That led me to to study GHC.Core.Opt.SpecConstr Note [SpecConstr needs to add void args first] which suggests the opposite! And indeed I think it's the other way round for SpecConstr -- or more precisely the void arg must precede the "extra_bndrs". That led me to some refactoring of GHC.Core.Opt.SpecConstr.calcSpecInfo. - - - - - f7ceafc9 by Krzysztof Gogolewski at 2023-01-11T22:36:59-05:00 Add 'docWithStyle' to improve codegen This new combinator docWithStyle :: IsOutput doc => doc -> (PprStyle -> SDoc) -> doc let us remove the need for code to be polymorphic in HDoc when not used in code style. Metric Decrease: ManyConstructors T13035 T1969 - - - - - b3be0d18 by Simon Peyton Jones at 2023-01-11T22:37:35-05:00 Fix finaliseArgBoxities for OPAQUE function We never do worker wrapper for OPAQUE functions, so we must zap the unboxing info during strictness analysis. This patch fixes #22502 - - - - - db11f358 by Ben Gamari at 2023-01-12T07:49:04-05:00 Revert "rts: Drop racy assertion" The logic here was inverted. Reverting the commit to avoid confusion when examining the commit history. This reverts commit b3eacd64fb36724ed6c5d2d24a81211a161abef1. - - - - - 3242139f by Ben Gamari at 2023-01-12T07:49:04-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 9ffd5d57 by Ben Gamari at 2023-01-12T07:49:41-05:00 configure: Fix escaping of `$tooldir` In !9547 I introduced `$tooldir` directories into GHC's default link and compilation flags to ensure that our C toolchain finds its own headers and libraries before others on the system. However, the patch was subtly wrong in the escaping of `$tooldir`. Fix this. Fixes #22561. - - - - - 905d0b6e by Sebastian Graf at 2023-01-12T15:51:47-05:00 Fix contification with stable unfoldings (#22428) Many functions now return a `TailUsageDetails` that adorns a `UsageDetails` with a `JoinArity` that reflects the number of join point binders around the body for which the `UsageDetails` was computed. `TailUsageDetails` is now returned by `occAnalLamTail` as well as `occAnalUnfolding` and `occAnalRules`. I adjusted `Note [Join points and unfoldings/rules]` and `Note [Adjusting right-hand sides]` to account for the new machinery. I also wrote a new `Note [Join arity prediction based on joinRhsArity]` and refer to it when we combine `TailUsageDetails` for a recursive RHS. I also renamed * `occAnalLam` to `occAnalLamTail` * `adjustRhsUsage` to `adjustTailUsage` * a few other less important functions and properly documented the that each call of `occAnalLamTail` must pair up with `adjustTailUsage`. I removed `Note [Unfoldings and join points]` because it was redundant with `Note [Occurrences in stable unfoldings]`. While in town, I refactored `mkLoopBreakerNodes` so that it returns a condensed `NodeDetails` called `SimpleNodeDetails`. Fixes #22428. The refactoring seems to have quite beneficial effect on ghc/alloc performance: ``` CoOpt_Read(normal) ghc/alloc 784,778,420 768,091,176 -2.1% GOOD T12150(optasm) ghc/alloc 77,762,270 75,986,720 -2.3% GOOD T12425(optasm) ghc/alloc 85,740,186 84,641,712 -1.3% GOOD T13056(optasm) ghc/alloc 306,104,656 299,811,632 -2.1% GOOD T13253(normal) ghc/alloc 350,233,952 346,004,008 -1.2% T14683(normal) ghc/alloc 2,800,514,792 2,754,651,360 -1.6% T15304(normal) ghc/alloc 1,230,883,318 1,215,978,336 -1.2% T15630(normal) ghc/alloc 153,379,590 151,796,488 -1.0% T16577(normal) ghc/alloc 7,356,797,056 7,244,194,416 -1.5% T17516(normal) ghc/alloc 1,718,941,448 1,692,157,288 -1.6% T19695(normal) ghc/alloc 1,485,794,632 1,458,022,112 -1.9% T21839c(normal) ghc/alloc 437,562,314 431,295,896 -1.4% GOOD T21839r(normal) ghc/alloc 446,927,580 440,615,776 -1.4% GOOD geo. mean -0.6% minimum -2.4% maximum -0.0% ``` Metric Decrease: CoOpt_Read T10421 T12150 T12425 T13056 T18698a T18698b T21839c T21839r T9961 - - - - - a1491c87 by Andreas Klebinger at 2023-01-12T15:52:23-05:00 Only gc sparks locally when we can ensure marking is done. When performing GC without work stealing there was no guarantee that spark pruning was happening after marking of the sparks. This could cause us to GC live sparks under certain circumstances. Fixes #22528. - - - - - 8acfe930 by Cheng Shao at 2023-01-12T15:53:00-05:00 Change MSYSTEM to CLANG64 uniformly - - - - - 73bc162b by M Farkas-Dyck at 2023-01-12T15:53:42-05:00 Make `GHC.Tc.Errors.Reporter` take `NonEmpty ErrorItem` rather than `[ErrorItem]`, which lets us drop some panics. Also use the `BasicMismatch` constructor rather than `mkBasicMismatchMsg`, which lets us drop the "-Wno-incomplete-record-updates" flag. - - - - - 1b812b69 by Oleg Grenrus at 2023-01-12T15:54:21-05:00 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general - - - - - c79b2b65 by Matthew Pickering at 2023-01-12T15:54:58-05:00 Don't run hadrian-multi on fast-ci label Fixes #22667 - - - - - 9a3d6add by Bodigrim at 2023-01-13T00:46:36-05:00 Bump submodule bytestring to 0.11.4.0 Metric Decrease: T21839c T21839r - - - - - df33c13c by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Bump Darwin bootstrap toolchain This updates the bootstrap compiler on Darwin from 8.10.7 to 9.2.5, ensuring that we have the fix for #21964. - - - - - 756a66ec by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Pass -w to cabal update Due to cabal#8447, cabal-install 3.8.1.0 requires a compiler to run `cabal update`. - - - - - 1142f858 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump hsc2hs submodule - - - - - d4686729 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump process submodule - - - - - 84ae6573 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: Bump DOCKER_REV - - - - - d53598c5 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: enable xz parallel compression for x64 jobs - - - - - d31fcbca by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: use in-image emsdk for js jobs - - - - - 93b9bbc1 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: improve nix-shell for gen_ci.hs and fix some ghc/hlint warnings - Add a ghc environment including prebuilt dependencies to the nix-shell. Get rid of the ad hoc cabal cache and all dependencies are now downloaded from the nixos binary cache. - Make gen_ci.hs a cabal package with HLS integration, to make future hacking of gen_ci.hs easier. - Fix some ghc/hlint warnings after I got HLS to work. - For the lint-ci-config job, do a shallow clone to save a few minutes of unnecessary git checkout time. - - - - - 8acc56c7 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: source the toolchain env file in wasm jobs - - - - - 87194df0 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: add wasm ci jobs via gen_ci.hs - There is one regular wasm job run in validate pipelines - Additionally, int-native/unreg wasm jobs run in nightly/release pipelines Also, remove the legacy handwritten wasm ci jobs in .gitlab-ci.yml. - - - - - b6eb9bcc by Matthew Pickering at 2023-01-13T11:52:16+00:00 wasm ci: Remove wasm release jobs This removes the wasm release jobs, as we do not yet intend to distribute these binaries. - - - - - 496607fd by Simon Peyton Jones at 2023-01-13T16:52:07-05:00 Add a missing checkEscapingKind Ticket #22743 pointed out that there is a missing check, for type-inferred bindings, that the inferred type doesn't have an escaping kind. The fix is easy. - - - - - 7a9a1042 by Andreas Klebinger at 2023-01-16T20:48:19-05:00 Separate core inlining logic from `Unfolding` type. This seems like a good idea either way, but is mostly motivated by a patch where this avoids a module loop. - - - - - 33b58f77 by sheaf at 2023-01-16T20:48:57-05:00 Hadrian: generalise &%> to avoid warnings This patch introduces a more general version of &%> that works with general traversable shapes, instead of lists. This allows us to pass along the information that the length of the list of filepaths passed to the function exactly matches the length of the input list of filepath patterns, avoiding pattern match warnings. Fixes #22430 - - - - - 8c7a991c by Andreas Klebinger at 2023-01-16T20:49:34-05:00 Add regression test for #22611. A case were a function used to fail to specialize, but now does. - - - - - 6abea760 by Andreas Klebinger at 2023-01-16T20:50:10-05:00 Mark maximumBy/minimumBy as INLINE. The RHS was too large to inline which often prevented the overhead of the Maybe from being optimized away. By marking it as INLINE we can eliminate the overhead of both the maybe and are able to unpack the accumulator when possible. Fixes #22609 - - - - - 99d151bb by Matthew Pickering at 2023-01-16T20:50:50-05:00 ci: Bump CACHE_REV so that ghc-9.6 branch and HEAD have different caches Having the same CACHE_REV on both branches leads to issues where the darwin toolchain is different on ghc-9.6 and HEAD which leads to long darwin build times. In general we should ensure that each branch has a different CACHE_REV. - - - - - 6a5845fb by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in source-tarball job This fixes errors of the form: ``` fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc inferred 9.7.20230113 checking for GHC Git commit id... fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc ``` - - - - - 4afb952c by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't build aarch64-deb10-llvm job on release pipelines Closes #22721 - - - - - 8039feb9 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in test-bootstrap job - - - - - 0b358d0c by Matthew Pickering at 2023-01-16T20:51:25-05:00 rel_eng: Add release engineering scripts into ghc tree It is better to keep these scripts in the tree as they depend on the CI configuration and so on. By keeping them in tree we can keep them up-to-date as the CI config changes and also makes it easier to backport changes to the release script between release branches in future. The final motivation is that it makes generating GHCUp metadata possible. - - - - - 28cb2ed0 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't use complicated image or clone in not-interruptible job This job exists only for the meta-reason of not allowing nightly pipelines to be cancelled. It was taking two minutes to run as in order to run "true" we would also clone the whole GHC repo. - - - - - eeea59bb by Matthew Pickering at 2023-01-16T20:51:26-05:00 Add scripts to generate ghcup metadata on nightly and release pipelines 1. A python script in .gitlab/rel_eng/mk-ghcup-metadata which generates suitable metadata for consumption by GHCUp for the relevant pipelines. - The script generates the metadata just as the ghcup maintainers want, without taking into account platform/library combinations. It is updated manually when the mapping changes. - The script downloads the bindists which ghcup wants to distribute, calculates the hash and generates the yaml in the correct structure. - The script is documented in the .gitlab/rel_eng/mk-ghcup-metadata/README.mk file 1a. The script requires us to understand the mapping from platform -> job. To choose the preferred bindist for each platform the .gitlab/gen_ci.hs script is modified to allow outputting a metadata file which answers the question about which job produces the bindist which we want to distribute to users for a specific platform. 2. Pipelines to run on nightly and release jobs to generate metadata - ghcup-metadata-nightly: Generates metadata which points directly to artifacts in the nightly job. - ghcup-metadata-release: Generates metadata suitable for inclusion directly in ghcup by pointing to the downloads folder where the bindist will be uploaded to. 2a. Trigger jobs which test the generated metadata in the downstream `ghccup-ci` repo. See that repo for documentation about what is tested and how but essentially we test in a variety of clean images that ghcup can download and install the bindists we say exist in our metadata. - - - - - 97bd4d8c by Bodigrim at 2023-01-16T20:52:04-05:00 Bump submodule parsec to 3.1.16.1 - - - - - 97ac8230 by Alan Zimmerman at 2023-01-16T20:52:39-05:00 EPA: Add annotation for 'type' in DataDecl Closes #22765 - - - - - dbbab95d by Ben Gamari at 2023-01-17T06:36:06-05:00 compiler: Small optimisation of assertM In #22739 @AndreasK noticed that assertM performed the action to compute the asserted predicate regardless of whether DEBUG is enabled. This is inconsistent with the other assertion operations and general convention. Fix this. Closes #22739. - - - - - fc02f3bb by Viktor Dukhovni at 2023-01-17T06:36:47-05:00 Avoid unnecessary printf warnings in EventLog.c Fixes #22778 - - - - - 003b6d44 by Simon Peyton Jones at 2023-01-17T16:33:05-05:00 Document the semantics of pattern bindings a bit better This MR is in response to the discussion on #22719 - - - - - f4d50baf by Vladislav Zavialov at 2023-01-17T16:33:41-05:00 Hadrian: fix warnings (#22783) This change fixes the following warnings when building Hadrian: src/Hadrian/Expression.hs:38:10: warning: [-Wredundant-constraints] src/Hadrian/Expression.hs:84:13: warning: [-Wtype-equality-requires-operators] src/Hadrian/Expression.hs:84:21: warning: [-Wtype-equality-requires-operators] src/Hadrian/Haskell/Cabal/Parse.hs:67:1: warning: [-Wunused-imports] - - - - - 06036d93 by Sylvain Henry at 2023-01-18T01:55:10-05:00 testsuite: req_smp --> req_target_smp, req_ghc_smp See #22630 and !9552 This commit: - splits req_smp into req_target_smp and req_ghc_smp - changes the testsuite driver to calculate req_ghc_smp - changes a handful of tests to use req_target_smp instead of req_smp - changes a handful of tests to use req_host_smp when needed The problem: - the problem this solves is the ambiguity surrounding req_smp - on master req_smp was used to express the constraint that the program being compiled supports smp _and_ that the host RTS (i.e., the RTS used to compile the program) supported smp. Normally that is fine, but in cross compilation this is not always the case as was discovered in #22630. The solution: - Differentiate the two constraints: - use req_target_smp to say the RTS the compiled program is linked with (and the platform) supports smp - use req_host_smp to say the RTS the host is linked with supports smp WIP: fix req_smp (target vs ghc) add flag to separate bootstrapper split req_smp -> req_target_smp and req_ghc_smp update tests smp flags cleanup and add some docstrings only set ghc_with_smp to bootstrapper on S1 or CC Only set ghc_with_smp to bootstrapperWithSMP of when testing stage 1 and cross compiling test the RTS in config/ghc not hadrian re-add ghc_with_smp fix and align req names fix T11760 to use req_host_smp test the rts directly, avoid python 3.5 limitation test the compiler in a try block align out of tree and in tree withSMP flags mark failing tests as host req smp testsuite: req_host_smp --> req_ghc_smp Fix ghc vs host, fix ghc_with_smp leftover - - - - - ee9b78aa by Krzysztof Gogolewski at 2023-01-18T01:55:45-05:00 Use -Wdefault when running Python testdriver (#22727) - - - - - e9c0537c by Vladislav Zavialov at 2023-01-18T01:56:22-05:00 Enable -Wstar-is-type by default (#22759) Following the plan in GHC Proposal #143 "Remove the * kind syntax", which states: In the next release (or 3 years in), enable -fwarn-star-is-type by default. The "next release" happens to be 9.6.1 I also moved the T21583 test case from should_fail to should_compile, because the only reason it was failing was -Werror=compat in our test suite configuration. - - - - - 4efee43d by Ryan Scott at 2023-01-18T01:56:59-05:00 Add missing parenthesizeHsType in cvtSigTypeKind We need to ensure that the output of `cvtSigTypeKind` is parenthesized (at precedence `sigPrec`) so that any type signatures with an outermost, explicit kind signature can parse correctly. Fixes #22784. - - - - - f891a442 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. - - - - - b13c6ea5 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. - - - - - c45a5fff by Cheng Shao at 2023-01-18T07:28:37-05:00 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. - - - - - b4c14c4b by Luite Stegeman at 2023-01-18T14:21:42-05:00 Add PrimCallConv support to GHCi This adds support for calling Cmm code from bytecode using the native calling convention, allowing modules that use `foreign import prim` to be loaded and debugged in GHCi. This patch introduces a new `PRIMCALL` bytecode instruction and a helper stack frame `stg_primcall`. The code is based on the existing functionality for dealing with unboxed tuples in bytecode, which has been generalised to handle arbitrary calls. Fixes #22051 - - - - - d0a63ef8 by Adam Gundry at 2023-01-18T14:22:26-05:00 Refactor warning flag parsing to add missing flags This adds `-Werror=<group>` and `-fwarn-<group>` flags for warning groups as well as individual warnings. Previously these were defined on an ad hoc basis so for example we had `-Werror=compat` but not `-Werror=unused-binds`, whereas we had `-fwarn-unused-binds` but not `-fwarn-compat`. Fixes #22182. - - - - - 7ed1b8ef by Adam Gundry at 2023-01-18T14:22:26-05:00 Minor corrections to comments - - - - - 5389681e by Adam Gundry at 2023-01-18T14:22:26-05:00 Revise warnings documentation in user's guide - - - - - ab0d5cda by Adam Gundry at 2023-01-18T14:22:26-05:00 Move documentation of deferred type error flags out of warnings section - - - - - eb5a6b91 by John Ericson at 2023-01-18T22:24:10-05:00 Give the RTS it's own configure script Currently it doesn't do much anything, we are just trying to introduce it without breaking the build. Later, we will move functionality from the top-level configure script over to it. We need to bump Cabal for https://github.com/haskell/cabal/pull/8649; to facilitate and existing hack of skipping some configure checks for the RTS we now need to skip just *part* not *all* of the "post configure" hook, as running the configure script (which we definitely want to do) is also implemented as part of the "post configure" hook. But doing this requires exposing functionality that wasn't exposed before. - - - - - 32ab07bf by Bodigrim at 2023-01-18T22:24:51-05:00 ghc package does not have to depend on terminfo - - - - - 981ff7c4 by Bodigrim at 2023-01-18T22:24:51-05:00 ghc-pkg does not have to depend on terminfo - - - - - f058e367 by Ben Gamari at 2023-01-18T22:25:27-05:00 nativeGen/X86: MFENCE is unnecessary for release semantics In #22764 a user noticed that a program implementing a simple atomic counter via an STRef regressed significantly due to the introduction of necessary atomic operations in the MutVar# primops (#22468). This regression was caused by a bug in the NCG, which emitted an unnecessary MFENCE instruction for a release-ordered atomic write. MFENCE is rather only needed to achieve sequentially consistent ordering. Fixes #22764. - - - - - 154889db by Ryan Scott at 2023-01-18T22:26:03-05:00 Add regression test for #22151 Issue #22151 was coincidentally fixed in commit aed1974e92366ab8e117734f308505684f70cddf (`Refactor the treatment of loopy superclass dicts`). This adds a regression test to ensure that the issue remains fixed. Fixes #22151. - - - - - 14b5982a by Andrei Borzenkov at 2023-01-18T22:26:43-05:00 Fix printing of promoted MkSolo datacon (#22785) Problem: In 2463df2f, the Solo data constructor was renamed to MkSolo, and Solo was turned into a pattern synonym for backwards compatibility. Since pattern synonyms can not be promoted, the old code that pretty-printed promoted single-element tuples started producing ill-typed code: t :: Proxy ('Solo Int) This fails with "Pattern synonym ‘Solo’ used as a type" The solution is to track the distinction between type constructors and data constructors more carefully when printing single-element tuples. - - - - - 1fe806d3 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add hi_core flavour transformer The hi_core flavour transformer enables -fwrite-if-simplified-core for stage1 libraries, which emit core into interface files to make it possible to restart code generation. Building boot libs with it makes it easier to use GHC API to prototype experimental backends that needs core/stg at link time. - - - - - 317cad26 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add missing docs for recently added flavour transformers - - - - - 658f4446 by Ben Gamari at 2023-01-23T04:49:23-05:00 gitlab-ci: Add Rocky8 jobs Addresses #22268. - - - - - a83ec778 by Vladislav Zavialov at 2023-01-23T04:49:58-05:00 Set "since: 9.8" for TypeAbstractions and -Wterm-variable-capture These flags did not make it into the 9.6 release series, so the "since" annotations must be corrected. - - - - - fec7c2ea by Alan Zimmerman at 2023-01-23T04:50:33-05:00 EPA: Add SourceText to HsOverLabel To be able to capture string literals with possible escape codes as labels. Close #22771 - - - - - 3efd1e99 by Ben Gamari at 2023-01-23T04:51:08-05:00 template-haskell: Bump version to 2.20.0.0 Updates `text` and `exceptions` submodules for bounds bumps. Addresses #22767. - - - - - 0900b584 by Cheng Shao at 2023-01-23T04:51:45-05:00 hadrian: disable alloca for in-tree GMP on wasm32 When building in-tree GMP for wasm32, disable its alloca usage, since it may potentially cause stack overflow (e.g. #22602). - - - - - db0f1bfd by Cheng Shao at 2023-01-23T04:52:21-05:00 Bump process submodule Includes a critical fix for wasm32, see https://github.com/haskell/process/pull/272 for details. Also changes the existing cross test to include process stuff and avoid future regression here. - - - - - 9222b167 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Fix subdir for windows bindist - - - - - 9a9bec57 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Remove viPostRemove field from generated metadata This has been removed from the downstream metadata. - - - - - 82884ce0 by Simon Peyton Jones at 2023-01-23T04:53:32-05:00 Fix #22742 runtimeRepLevity_maybe was panicing unnecessarily; and the error printing code made use of the case when it should return Nothing rather than panicing. For some bizarre reason perf/compiler/T21839r shows a 10% bump in runtime peak-megagbytes-used, on a single architecture (alpine). See !9753 for commentary, but I'm going to accept it. Metric Increase: T21839r - - - - - 2c6deb18 by Bryan Richter at 2023-01-23T14:12:22+02:00 codeowners: Add Ben, Matt, and Bryan to CI - - - - - eee3bf05 by Matthew Craven at 2023-01-23T21:46:41-05:00 Do not collect compile-time metrics for T21839r ...the testsuite doesn't handle this properly since it also collects run-time metrics. Compile-time metrics for this test are already tracked via T21839c. Metric Decrease: T21839r - - - - - 1d1dd3fb by Matthew Pickering at 2023-01-24T05:37:52-05:00 Fix recompilation checking for multiple home units The key part of this change is to store a UnitId in the `UsageHomeModule` and `UsageHomeModuleInterface`. * Fine-grained dependency tracking is used if the dependency comes from any home unit. * We actually look up the right module when checking whether we need to recompile in the `UsageHomeModuleInterface` case. These scenarios are both checked by the new tests ( multipleHomeUnits_recomp and multipleHomeUnits_recomp_th ) Fixes #22675 - - - - - 7bfb30f9 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Augment target filepath by working directory when checking if module satisfies target This fixes a spurious warning in -Wmissing-home-modules. This is a simple oversight where when looking for the target in the first place we augment the search by the -working-directory flag but then fail to do so when checking this warning. Fixes #22676 - - - - - 69500dd4 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Use NodeKey rather than ModuleName in pruneCache The `pruneCache` function assumes that the list of `CachedInfo` all have unique `ModuleName`, this is not true: * In normal compilation, the same module name can appear for a file and it's boot file. * In multiple home unit compilation the same ModuleName can appear in different units The fix is to use a `NodeKey` as the actual key for the interfaces which includes `ModuleName`, `IsBoot` and `UnitId`. Fixes #22677 - - - - - 336b2b1c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Recompilation checking: Don't try to find artefacts for Interactive & hs-boot combo In interactive mode we don't produce any linkables for hs-boot files. So we also need to not going looking for them when we check to see if we have all the right objects needed for recompilation. Ticket #22669 - - - - - 6469fea7 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Don't write o-boot files in Interactive mode We should not be producing object files when in interactive mode but we still produced the dummy o-boot files. These never made it into a `Linkable` but then confused the recompilation checker. Fixes #22669 - - - - - 06cc0a95 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Improve driver diagnostic messages by including UnitId in message Currently the driver diagnostics don't give any indication about which unit they correspond to. For example `-Wmissing-home-modules` can fire multiple times for each different home unit and gives no indication about which unit it's actually reporting about. Perhaps a longer term fix is to generalise the providence information away from a SrcSpan so that these kind of whole project errors can be reported with an accurate provenance. For now we can just include the `UnitId` in the error message. Fixes #22678 - - - - - 4fe9eaff by Matthew Pickering at 2023-01-24T05:37:52-05:00 Key ModSummary cache by UnitId as well as FilePath Multiple units can refer to the same files without any problem. Just another assumption which needs to be updated when we may have multiple home units. However, there is the invariant that within each unit each file only maps to one module, so as long as we also key the cache by UnitId then we are all good. This led to some confusing behaviour in GHCi when reloading, multipleHomeUnits_shared distils the essence of what can go wrong. Fixes #22679 - - - - - ada29f5c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Finder: Look in current unit before looking in any home package dependencies In order to preserve existing behaviour it's important to look within the current component before consideirng a module might come from an external component. This already happened by accident in `downsweep`, (because roots are used to repopulated the cache) but in the `Finder` the logic was the wrong way around. Fixes #22680 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp -------------------------p - - - - - be701cc6 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Debug: Print full NodeKey when pretty printing ModuleGraphNode This is helpful when debugging multiple component issues. - - - - - 34d2d463 by Krzysztof Gogolewski at 2023-01-24T05:38:32-05:00 Fix Lint check for duplicate external names Lint was checking for duplicate external names by calling removeDups, which needs a comparison function that is passed to Data.List.sortBy. But the comparison was not a valid ordering - it returned LT if one of the names was not external. For example, the previous implementation won't find a duplicate in [M.x, y, M.x]. Instead, we filter out non-external names before looking for duplicates. - - - - - 1c050ed2 by Matthew Pickering at 2023-01-24T05:39:08-05:00 Add test for T22671 This was fixed by b13c6ea5 Closes #22671 - - - - - 05e6a2d9 by Tom Ellis at 2023-01-24T12:10:52-05:00 Clarify where `f` is defined - - - - - d151546e by Cheng Shao at 2023-01-24T12:11:29-05:00 CmmToC: fix CmmRegOff for 64-bit register on a 32-bit target We used to print the offset value to a platform word sized integer. This is incorrect when the offset is negative (e.g. output of cmm constant folding) and the register is 64-bit but on a 32-bit target, and may lead to incorrect runtime result (e.g. #22607). The fix is simple: just treat it as a proper MO_Add, with the correct width info inferred from the register itself. Metric Increase: T12707 T13379 T4801 T5321FD T5321Fun - - - - - 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 - - - - - 1bd32a35 by Sylvain Henry at 2023-01-26T12:34:21-05:00 Factorize hptModulesBelow Create and use moduleGraphModulesBelow in GHC.Unit.Module.Graph that doesn't need anything from the driver to be used. - - - - - 1262d3f8 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Store dehydrated data structures in CgModBreaks This fixes a tricky leak in GHCi where we were retaining old copies of HscEnvs when reloading. If not all modules were recompiled then these hydrated fields in break points would retain a reference to the old HscEnv which could double memory usage. Fixes #22530 - - - - - e27eb80c by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force more in NFData Name instance Doesn't force the lazy `OccName` field (#19619) which is already known as a really bad source of leaks. When we slam the hammer storing Names on disk (in interface files or the like), all this should be forced as otherwise a `Name` can easily retain an `Id` and hence the entire world. Fixes #22833 - - - - - 3d004d5a by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force OccName in tidyTopName This occname has just been derived from an `Id`, so need to force it promptly so we can release the Id back to the world. Another symptom of the bug caused by #19619 - - - - - f2a0fea0 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Strict fields in ModNodeKey (otherwise retains HomeModInfo) Towards #22530 - - - - - 5640cb1d by Sylvain Henry at 2023-01-26T12:35:36-05:00 Hadrian: fix doc generation Was missing dependencies on files generated by templates (e.g. ghc.cabal) - - - - - 3e827c3f by Richard Eisenberg at 2023-01-26T20:06:53-05:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. - - - - - b3ef5c89 by doyougnu at 2023-01-26T20:07:48-05:00 tryFillBuffer: strictify more speculative bangs - - - - - d0d7ba0f by Vladislav Zavialov at 2023-01-26T20:08:25-05:00 base: NoImplicitPrelude in Data.Void and Data.Kind This change removes an unnecessary dependency on Prelude from two modules in the base package. - - - - - fa1db923 by Matthew Pickering at 2023-01-26T20:09:00-05: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 - - - - - 807310a1 by Matthew Pickering at 2023-01-26T20:09:00-05:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. - - - - - c7116b10 by Ben Gamari at 2023-01-26T20:09:35-05:00 base: Make changelog proposal references more consistent Addresses #22773. - - - - - 6932cfc7 by Sylvain Henry at 2023-01-26T20:10:27-05:00 Fix spurious change from !9568 - - - - - e480fbc2 by Ben Gamari at 2023-01-27T05:01:24-05:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 - - - - - 2648c09c by Andrei Borzenkov at 2023-01-27T05:02:07-05:00 Replace errors from badOrigBinding with new one (#22839) Problem: in 02279a9c the type-level [] syntax was changed from a built-in name to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if a name is not built-in then it must have come from TH quotation, but this is not necessarily the case with []. The outdated assumption in badOrigBinding leads to incorrect error messages. This code: data [] Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []" Unfortunately, there is not enough information in RdrName to directly determine if the name was constructed via TH or by the parser, so this patch changes the error message instead. It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote into a new error TcRnBindingOfExistingName and changes its wording to avoid guessing the origin of the name. - - - - - 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b8856be5 by Peter Trommler at 2023-02-05T17:25:09+01:00 PPC: Support ELF v2 on powerpc64 big-endian Detect ELF v2 on PowerPC 64-bit systems. Check for `_CALL_ELF` preprocessor macro. Fixes #21191 - - - - - 85fe2fa3 by Sylvain Henry at 2023-02-05T17:25:15+01:00 Fix copy-paste - - - - - 13 changed files: - − .appveyor.sh - .editorconfig - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/nix/sources.json - .gitlab/darwin/toolchain.nix - + .gitlab/gen-ci.cabal - .gitlab/gen_ci.hs - + .gitlab/generate_job_metadata - .gitlab/generate_jobs - + .gitlab/hello.hs - + .gitlab/hie.yaml The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/717a4ef34b6af44cba07d83c9a4794b3a5addb81...85fe2fa3b299eda5ea9fdcd6cfba9930efab1fcf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/717a4ef34b6af44cba07d83c9a4794b3a5addb81...85fe2fa3b299eda5ea9fdcd6cfba9930efab1fcf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Feb 5 16:50:45 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sun, 05 Feb 2023 11:50:45 -0500 Subject: [Git][ghc/ghc][wip/int-index/visibility-check] Ignore forall visibility in eqType (#22762) Message-ID: <63dfde6532ccd_1108fedca32a0969633@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/visibility-check at Glasgow Haskell Compiler / GHC Commits: c08a6e9f by Vladislav Zavialov at 2023-02-05T19:50:25+03:00 Ignore forall visibility in eqType (#22762) Prior to this change, the equality relation on types took ForAllTyFlag into account, making a distinction between: 1. forall a. blah 2. forall a -> blah Not anymore. This distinction is important in surface Haskell, but it has no meaning in Core where type abstraction and type application are always explicit. At the same time, if we are not careful to track this flag, Core Lint will fail, as reported in #22762: *** Core Lint errors : in result of TcGblEnv axioms *** From-kind of Cast differs from kind of enclosed type From-kind: forall (b :: Bool) -> * Kind of enclosed type: forall {b :: Bool}. * The solution is to compare types for equality modulo visibility (ForAllTyFlag). Updated functions: nonDetCmpType (worker for eqType) eqDeBruijnType tc_eq_type (worker for tcEqType) can_eq_nc In order to retain the distinction between visible and invisible forall in user-written code, we introduce new ad-hoc checks: checkEqForallVis (in checking mode) cteForallKindVisDiff (in inference mode) - - - - - 24 changed files: - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Types/Error/Codes.hs - testsuite/tests/saks/should_fail/T18863a.stderr - + testsuite/tests/typecheck/should_compile/T22762.hs - testsuite/tests/typecheck/should_compile/all.T - + testsuite/tests/typecheck/should_fail/VisFlag1.hs - + testsuite/tests/typecheck/should_fail/VisFlag1.stderr - + testsuite/tests/typecheck/should_fail/VisFlag1_ql.hs - + testsuite/tests/typecheck/should_fail/VisFlag1_ql.stderr - + testsuite/tests/typecheck/should_fail/VisFlag2.hs - + testsuite/tests/typecheck/should_fail/VisFlag2.stderr - + testsuite/tests/typecheck/should_fail/VisFlag3.hs - + testsuite/tests/typecheck/should_fail/VisFlag3.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Core/Map/Type.hs ===================================== @@ -38,7 +38,6 @@ import GHC.Prelude import GHC.Core.Type import GHC.Core.Coercion import GHC.Core.TyCo.Rep -import GHC.Core.TyCo.Compare( eqForAllVis ) import GHC.Data.TrieMap import GHC.Data.FastString @@ -261,11 +260,9 @@ eqDeBruijnType env_t1@(D env1 t1) env_t2@(D env2 t2) = -> liftEquality (tc == tc') `andEq` gos env env' tys tys' (LitTy l, LitTy l') -> liftEquality (l == l') - (ForAllTy (Bndr tv vis) ty, ForAllTy (Bndr tv' vis') ty') - -> -- See Note [ForAllTy and type equality] in - -- GHC.Core.TyCo.Compare for why we use `eqForAllVis` here - liftEquality (vis `eqForAllVis` vis') `andEq` - go (D env (varType tv)) (D env' (varType tv')) `andEq` + (ForAllTy (Bndr tv _) ty, ForAllTy (Bndr tv' _) ty') + -- Ignore ForAllTyFlag. See Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare + -> go (D env (varType tv)) (D env' (varType tv')) `andEq` go (D (extendCME env tv) ty) (D (extendCME env' tv') ty') (CoercionTy {}, CoercionTy {}) -> TEQ ===================================== compiler/GHC/Core/TyCo/Compare.hs ===================================== @@ -16,7 +16,7 @@ module GHC.Core.TyCo.Compare ( tcEqTyConApps, -- * Visiblity comparision - eqForAllVis, cmpForAllVis + eqForAllVis, ) where @@ -171,11 +171,13 @@ tc_eq_type keep_syns vis_only orig_ty1 orig_ty2 go _ (LitTy lit1) (LitTy lit2) = lit1 == lit2 - go env (ForAllTy (Bndr tv1 vis1) ty1) - (ForAllTy (Bndr tv2 vis2) ty2) - = vis1 `eqForAllVis` vis2 - && (vis_only || go env (varType tv1) (varType tv2)) - && go (rnBndr2 env tv1 tv2) ty1 ty2 + go env (ForAllTy (Bndr tv1 _) ty1) + (ForAllTy (Bndr tv2 _) ty2) + -- Ignore ForAllTyFlag. See Note [ForAllTy and type equality] + = kinds_eq && go (rnBndr2 env tv1 tv2) ty1 ty2 + where + kinds_eq | vis_only = True + | otherwise = go env (varType tv1) (varType tv2) -- Make sure we handle all FunTy cases since falling through to the -- AppTy case means that tcSplitAppTyNoView_maybe may see an unzonked @@ -227,7 +229,9 @@ tc_eq_type keep_syns vis_only orig_ty1 orig_ty2 -- | Do these denote the same level of visibility? 'Required' -- arguments are visible, others are not. So this function --- equates 'Specified' and 'Inferred'. Used for printing. +-- equates 'Specified' and 'Inferred'. +-- +-- Used for printing and in tcEqForallVis. eqForAllVis :: ForAllTyFlag -> ForAllTyFlag -> Bool -- See Note [ForAllTy and type equality] -- If you change this, see IMPORTANT NOTE in the above Note @@ -235,26 +239,38 @@ eqForAllVis Required Required = True eqForAllVis (Invisible _) (Invisible _) = True eqForAllVis _ _ = False --- | Do these denote the same level of visibility? 'Required' --- arguments are visible, others are not. So this function --- equates 'Specified' and 'Inferred'. Used for printing. -cmpForAllVis :: ForAllTyFlag -> ForAllTyFlag -> Ordering --- See Note [ForAllTy and type equality] --- If you change this, see IMPORTANT NOTE in the above Note -cmpForAllVis Required Required = EQ -cmpForAllVis Required (Invisible {}) = LT -cmpForAllVis (Invisible _) Required = GT -cmpForAllVis (Invisible _) (Invisible _) = EQ - - {- Note [ForAllTy and type equality] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When we compare (ForAllTy (Bndr tv1 vis1) ty1) and (ForAllTy (Bndr tv2 vis2) ty2) -what should we do about `vis1` vs `vis2`. - -First, we always compare with `eqForAllVis` and `cmpForAllVis`. -But what decision do we make? +what should we do about `vis1` vs `vis2`? + +One option is to take those flags into account and check (vis1==vis2). +But in Core visibility of forall-bound variables has no meaning, +as type abstraction and type application are always explicit. +Going to great lengths to carry them around is counterproductive, +but not going far enough may lead to Core Lint errors (#22762). + +The other option (the one we take) is to ignore those flags. +Neither the name of a forall-bound variable nor its visibility flag +affect GHC's notion of type equality. + +That said, in user-written programs visibility of foralls does matter +a great deal. For example, if we unify tv := T, where + tv :: forall k. k -> Type + T :: forall k -> k -> Type +then the user can not substitute `T Maybe` for `tv Maybe` in their program +by hand. They'd have to write `T (Type -> Type) Maybe` instead. +This entails loss referential transparency. We solve this issue by +checking the flags *outside* the equality relation. To that end, +there are two ad-hoc checks: + * checkEqForallVis (in checking mode) + * cteForallKindVisDiff (in inference mode) + +These checks use `eqForAllVis` to compare the `ForAllTyFlag`s. +But should we perhaps use (==) instead? +Do we only care about visibility (Required vs Invisible) +or do we also care about specificity (Specified vs Inferred)? Should GHC type-check the following program (adapted from #15740)? @@ -280,12 +296,7 @@ programs like the one above. Whether a kind variable binder ends up being specified or inferred can be somewhat subtle, however, especially for kinds that aren't explicitly written out in the source code (like in D above). -For now, we decide - - the specified/inferred status of an invisible type variable binder - does not affect GHC's notion of equality. - -That is, we have the following: +For now, we decide to ignore specificity. That is, we have the following: -------------------------------------------------- | Type 1 | Type 2 | Equal? | @@ -303,11 +314,9 @@ That is, we have the following: | | forall k -> <...> | Yes | -------------------------------------------------- -IMPORTANT NOTE: if we want to change this decision, ForAllCo will need to carry -visiblity (by taking a ForAllTyBinder rathre than a TyCoVar), so that -coercionLKind/RKind build forall types that match (are equal to) the desired -ones. Otherwise we get an infinite loop in the solver via canEqCanLHSHetero. -Examples: T16946, T15079. +One unfortunate consequence of this setup is that it can be exploited +to observe the order of inferred quantification (#22648). However, fixing this +would be a breaking change, so we choose not to (at least for now). Historical Note [Typechecker equality vs definitional equality] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -335,7 +344,7 @@ is more finer-grained than definitional equality in two places: Constraint, but typechecker treats them as distinct types. * Unlike definitional equality, which does not care about the ForAllTyFlag of a - ForAllTy, typechecker equality treats Required type variable binders as + ForAllTy, typechecker equality treated Required type variable binders as distinct from Invisible type variable binders. See Note [ForAllTy and type equality] @@ -513,9 +522,9 @@ nonDetCmpTypeX env orig_t1 orig_t2 = go env (TyVarTy tv1) (TyVarTy tv2) = liftOrdering $ rnOccL env tv1 `nonDetCmpVar` rnOccR env tv2 - go env (ForAllTy (Bndr tv1 vis1) t1) (ForAllTy (Bndr tv2 vis2) t2) - = liftOrdering (vis1 `cmpForAllVis` vis2) - `thenCmpTy` go env (varType tv1) (varType tv2) + go env (ForAllTy (Bndr tv1 _) t1) (ForAllTy (Bndr tv2 _) t2) + -- Ignore ForAllTyFlag. See Note [ForAllTy and type equality] + = go env (varType tv1) (varType tv2) `thenCmpTy` go (rnBndr2 env tv1 tv2) t1 t2 -- See Note [Equality on AppTys] ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -1673,6 +1673,16 @@ mkTyVarEqErr' ctxt item (tv1, co1) ty2 -- to be helpful since this is just an unimplemented feature. return (main_msg, []) + -- The kinds of 'tv1' and 'ty2' contain forall-bound variables that + -- differ in visibility (ForAllTyFlag). + | check_eq_result `cterHasProblem` cteForallKindVisDiff + = let reason = ForallKindVisDiff tv1 ty2 + main_msg = + CannotUnifyVariable + { mismatchMsg = headline_msg + , cannotUnifyReason = reason } + in return (main_msg, []) + | isSkolemTyVar tv1 -- ty2 won't be a meta-tyvar; we would have -- swapped in Solver.Canonical.canEqTyVarHomo || isTyVarTyVar tv1 && not (isTyVarTy ty2) ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1226,6 +1226,12 @@ instance Diagnostic TcRnMessage where TcRnSectionWithoutParentheses expr -> mkSimpleDecorated $ hang (text "A section must be enclosed in parentheses") 2 (text "thus:" <+> (parens (ppr expr))) + TcRnIncompatibleForallVisibility act exp -> + mkSimpleDecorated $ + hang (text "Visibilities of forall-bound variables are not compatible") 2 $ + vcat + [ text "Expected:" <+> ppr exp + , text " Actual:" <+> ppr act ] TcRnCapturedTermName tv_name shadowed_term_names -> mkSimpleDecorated $ @@ -1734,6 +1740,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnDuplicateMinimalSig{} -> ErrorWithoutFlag + TcRnIncompatibleForallVisibility{} + -> ErrorWithoutFlag diagnosticHints = \case TcRnUnknownMessage m @@ -2173,6 +2181,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnDuplicateMinimalSig{} -> noHints + TcRnIncompatibleForallVisibility{} + -> noHints diagnosticCode = constructorCode @@ -2970,6 +2980,10 @@ pprCannotUnifyVariableReason ctxt (DifferentTyVars tv_info) pprCannotUnifyVariableReason ctxt (RepresentationalEq tv_info mb_coercible_msg) = pprTyVarInfo ctxt tv_info $$ maybe empty pprCoercibleMsg mb_coercible_msg +pprCannotUnifyVariableReason _ (ForallKindVisDiff tv1 ty2) + = hang (text "Visibilities of forall-bound variables in kinds differ") 2 $ + vcat [ ppr tv1 <+> text "::" <+> ppr (tyVarKind tv1) + , ppr ty2 <+> text "::" <+> ppr (typeKind ty2) ] pprMismatchMsg :: SolverReportErrCtxt -> MismatchMsg -> SDoc pprMismatchMsg ctxt ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -2924,6 +2924,22 @@ data TcRnMessage where -} TcRnDuplicateMinimalSig :: LSig GhcPs -> LSig GhcPs -> [LSig GhcPs] -> TcRnMessage + {-| TcRnIncompatibleForallVisibility is an error that occurs when + the expected and actual types contain forall-bound variables + that have incompatible visibilities. + + Example: + type family Invis :: Type -> forall a. a + type family Vis :: Type -> forall a -> a + type instance Vis = Invis -- Bad instance + + Test cases: T18863a VisFlag1 VisFlag1_ql VisFlag2 VisFlag3 + -} + TcRnIncompatibleForallVisibility + :: TcType + -> TcType + -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. @@ -3787,6 +3803,20 @@ data CannotUnifyVariableReason -- type Int, or with a 'TyVarTv'. | DifferentTyVars TyVarInfo | RepresentationalEq TyVarInfo (Maybe CoercibleMsg) + + -- | Can't unify a kind-polymorphic type variable with a type + -- due to differences in visibility between forall-bound variables in their kinds. + -- + -- Example: + -- data V k (a :: k) = MkV + -- f :: forall {k} {a :: k} (hk :: forall j. j -> Type). hk a -> () + -- bad_infer = f MkV + -- -- we want to unify hk := V + -- -- but hk :: forall j. j -> Type + -- -- V :: forall k -> k -> Type + -- + -- Test cases: VisFlag1 + | ForallKindVisDiff TyVar Type deriving Generic -- | Report a mismatch error without any extra ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -361,7 +361,8 @@ tcApp rn_expr exp_res_ty -- app_res_rho and exp_res_ty are both rho-types, -- so with simple subsumption we can just unify them -- No need to zonk; the unifier does that - do { co <- unifyExpectedType rn_expr app_res_rho exp_res_ty + do { checkEqForallVis app_res_rho exp_res_ty + ; co <- unifyExpectedType rn_expr app_res_rho exp_res_ty ; return (mkWpCastN co) } else -- Deep subsumption @@ -371,6 +372,7 @@ tcApp rn_expr exp_res_ty -- Zonk app_res_rho first, because QL may have instantiated some -- delta variables to polytypes, and tcSubType doesn't expect that do { app_res_rho <- zonkQuickLook do_ql app_res_rho + ; checkEqForallVis app_res_rho exp_res_ty ; tcSubTypeDS rn_expr app_res_rho exp_res_ty } -- Typecheck the value arguments @@ -1050,9 +1052,9 @@ qlUnify delta ty1 ty2 -- Passes the occurs check = do { let ty2_kind = typeKind ty2 kappa_kind = tyVarKind kappa + ; checkEqForallVis ty2_kind (Check kappa_kind) ; co <- unifyKind (Just (TypeThing ty2)) ty2_kind kappa_kind -- unifyKind: see Note [Actual unification in qlUnify] - ; traceTc "qlUnify:update" $ vcat [ hang (ppr kappa <+> dcolon <+> ppr kappa_kind) 2 (text ":=" <+> ppr ty2 <+> dcolon <+> ppr ty2_kind) ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -1931,6 +1931,7 @@ checkExpectedKind hs_ty ty act_kind exp_kind ; let res_ty = ty `mkAppTys` new_args + ; checkEqForallVis act_kind' (mkCheckExpType exp_kind) ; if act_kind' `tcEqType` exp_kind then return res_ty -- This is very common else do { co_k <- uType KindLevel origin act_kind' exp_kind @@ -2552,6 +2553,7 @@ kcCheckDeclHeader_sig sig_kind name flav ; case ctx_k of AnyKind -> return () -- No signature _ -> do { res_ki <- newExpectedKind ctx_k + ; checkEqForallVis res_ki (mkCheckExpType sig_res_kind') ; discardResult (unifyKind Nothing sig_res_kind' res_ki) } -- Add more binders for data/newtype, so the result kind has no arrows @@ -3284,6 +3286,7 @@ bindExplicitTKBndrsX skol_mode@(SM { sm_parent = check_parent, sm_kind = ctxt_ki | check_parent , Just (ATyVar _ tv) <- lookupNameEnv lcl_env name = do { kind <- tc_lhs_kind_sig tc_ki_mode (TyVarBndrKindCtxt name) lhs_kind + ; checkEqForallVis kind (Check (tyVarKind tv)) ; discardResult $ unifyKind (Just . NameThing $ name) kind (tyVarKind tv) -- This unify rejects: ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -1095,9 +1095,9 @@ can_eq_nc' rewritten _rdr_env _envs ev eq_rel ty1 _ ty2 _ = canTyConApp rewritten ev eq_rel tc1 tys1 tc2 tys2 can_eq_nc' _rewritten _rdr_env _envs ev eq_rel - s1@(ForAllTy (Bndr _ vis1) _) _ - s2@(ForAllTy (Bndr _ vis2) _) _ - | vis1 `eqForAllVis` vis2 -- Note [ForAllTy and type equality] + s1@(ForAllTy _ _) _ + s2@(ForAllTy _ _) _ + -- Ignore ForAllTyFlag. See Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare = can_eq_nc_forall ev eq_rel s1 s2 -- See Note [Canonicalising type applications] about why we require rewritten types ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -34,6 +34,7 @@ module GHC.Tc.Types.Constraint ( CheckTyEqResult, CheckTyEqProblem, cteProblem, cterClearOccursCheck, cteOK, cteImpredicative, cteTypeFamily, cteInsolubleOccurs, cteSolubleOccurs, cterSetOccursCheckSoluble, + cteForallKindVisDiff, cterHasNoProblem, cterHasProblem, cterHasOnlyProblem, cterRemoveProblem, cterHasOccursCheck, cterFromKind, @@ -452,12 +453,13 @@ cterHasNoProblem _ = False -- | An individual problem that might be logged in a 'CheckTyEqResult' newtype CheckTyEqProblem = CTEP Word8 -cteImpredicative, cteTypeFamily, cteInsolubleOccurs, cteSolubleOccurs :: CheckTyEqProblem +cteImpredicative, cteTypeFamily, cteInsolubleOccurs, cteSolubleOccurs, cteForallKindVisDiff :: CheckTyEqProblem cteImpredicative = CTEP (bit 0) -- forall or (=>) encountered cteTypeFamily = CTEP (bit 1) -- type family encountered cteInsolubleOccurs = CTEP (bit 2) -- occurs-check cteSolubleOccurs = CTEP (bit 3) -- occurs-check under a type function or in a coercion -- must be one bit to the left of cteInsolubleOccurs +cteForallKindVisDiff = CTEP (bit 4) -- differing visibility of forall-bound variables in the kind -- See also Note [Insoluble occurs check] in GHC.Tc.Errors cteProblem :: CheckTyEqProblem -> CheckTyEqResult @@ -521,7 +523,8 @@ instance Outputable CheckTyEqResult where all_bits = [ (cteImpredicative, "cteImpredicative") , (cteTypeFamily, "cteTypeFamily") , (cteInsolubleOccurs, "cteInsolubleOccurs") - , (cteSolubleOccurs, "cteSolubleOccurs") ] + , (cteSolubleOccurs, "cteSolubleOccurs") + , (cteForallKindVisDiff, "cteForallKindVisDiff") ] set_bits = [ text str | (bitmask, str) <- all_bits , cter `cterHasProblem` bitmask ] ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -66,6 +66,10 @@ module GHC.Tc.Utils.TcMType ( checkingExpType_maybe, checkingExpType, inferResultToType, ensureMonoType, promoteTcType, + -------------------------------- + -- Visibility flag check + tcEqForallVis, checkEqForallVis, + -------------------------------- -- Zonking and tidying zonkTidyTcType, zonkTidyTcTypes, zonkTidyOrigin, zonkTidyOrigins, @@ -604,6 +608,103 @@ tc_infer mb_frr tc_check ; res_ty <- readExpType res_ty ; return (result, res_ty) } +{- ********************************************************************* +* * + Visibility flag check +* * +********************************************************************* -} + +-- Check if two presumably equal types actually differ in visibility +-- of their foralls. Example (from #18863): +-- +-- type IDa :: forall i -> i -> Type +-- data IDa :: forall i. i -> Type +-- +-- Report TcRnIncompatibleForallVisibility if the check fails. +-- +-- See Note [Presumably equal types] +checkEqForallVis :: TcType -> ExpType -> TcM () +checkEqForallVis _ (Infer _) = return () +checkEqForallVis ty1 (Check ty2) = + unless (tcEqForallVis ty1 ty2) $ + addErr $ TcRnIncompatibleForallVisibility ty1 ty2 + +-- Structurally match two presumably equal types, checking that all pairs of +-- foralls have equal visibility. +-- +-- See Note [Presumably equal types] +tcEqForallVis :: Type -> Type -> Bool +tcEqForallVis = matchUpForAllTyFlags eqForAllVis + +-- Structurally match two presumably equal types, checking that all pairs of +-- forall visibility flags (ForAllTyFlag) satisfy a predicate. +-- +-- For example, given the types +-- ty1 = forall a1. Bool -> forall b1. ... +-- ty2 = forall a2. Bool -> forall b2 -> ... +-- We have +-- matchUpForAllTyFlags f ty1 ty2 = +-- f Specified Specified && -- from (a1, a2) +-- f Specified Required -- from (b1, b2) +-- +-- Metavariables are of no interest to us: they stand for monotypes, so there +-- are no forall flags to be found. We do not look through metavariables. +-- +-- See Note [Presumably equal types] +matchUpForAllTyFlags + :: (ForAllTyFlag -> ForAllTyFlag -> Bool) + -> TcType -- actual + -> TcType -- expected + -> Bool +matchUpForAllTyFlags zip_flags actual expected = + go actual expected True + where + go :: TcType -> TcType -> Bool -> Bool + -- See Note [Comparing nullary type synonyms] in GHC.Core.Type + go (TyConApp tc1 []) (TyConApp tc2 []) cont | tc1 == tc2 = cont + + go t1 t2 cont | Just t1' <- coreView t1 = go t1' t2 cont + go t1 t2 cont | Just t2' <- coreView t2 = go t1 t2' cont + + go (ForAllTy (Bndr tv1 vis1) ty1) (ForAllTy (Bndr tv2 vis2) ty2) cont + = go (varType tv1) (varType tv2) $ + go ty1 ty2 $ + zip_flags vis1 vis2 && cont + + go (FunTy _ w1 arg1 res1) (FunTy _ w2 arg2 res2) cont = + go arg1 arg2 $ go res1 res2 $ go w1 w2 $ cont + go (AppTy s1 t1) (AppTy s2 t2) cont = + go s1 s2 $ go t1 t2 $ cont + go (TyConApp tc1 ts1) (TyConApp tc2 ts2) cont + | tc1 /= tc2 = True -- ex falso shortcut + | otherwise = gos ts1 ts2 cont + + go (CastTy t1 _) t2 cont = go t1 t2 cont + go t1 (CastTy t2 _) cont = go t1 t2 cont + go _ _ cont = cont + + gos (t1:ts1) (t2:ts2) cont = gos ts1 ts2 $ go t1 t2 cont + gos [] [] cont = cont + gos _ _ _ = True -- ex falso shortcut + +{- Note [Presumably equal types] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In matchUpForAllTyFlags (and by extension tcEqForallVis, checkEqForallVis) +we want to be checking the logical implication + (ty1 = ty2) ⊃ (forall flags satisfy the predicate) +If the assumption (ty1 = ty2) does not hold, the correct thing to do is to +return True (ex falso sequitur quodlibet). + +However, implementing these semantics precisely would make this function +more complicated and expensive. For instance, we'd have to maintain a RnEnv2 +to check type variables for equality. + +As a pragmatic compromise, we say that the result of matchUpForAllTyFlags is +not well-defined if (ty1 /= ty2). This should not matter in practice, as +those functions are only ever used in conjunction with an actual equality check. +The worst case scenario is that we report a less helpful error message. +-} + {- ********************************************************************* * * Promoting types ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -2636,12 +2636,14 @@ checkTypeEq :: CanEqLHS -> TcType -> CheckTyEqResult -- case-analysis on 'lhs') -- * checkEqCanLHSFinish, which does not know the form of 'lhs' checkTypeEq lhs ty - = go ty + = go ty S.<> + go_kind (canEqLHSKind lhs) (typeKind ty) where impredicative = cteProblem cteImpredicative type_family = cteProblem cteTypeFamily insoluble_occurs = cteProblem cteInsolubleOccurs soluble_occurs = cteProblem cteSolubleOccurs + forall_kind_vis_diff = cteProblem cteForallKindVisDiff -- The GHCi runtime debugger does its type-matching with -- unification variables that can unify with a polytype @@ -2721,3 +2723,8 @@ checkTypeEq lhs ty | ghci_tv = \ _tc -> cteOK | otherwise = \ tc -> (if isTauTyCon tc then cteOK else impredicative) S.<> (if isFamFreeTyCon tc then cteOK else type_family) + + go_kind :: TcKind -> TcKind -> CheckTyEqResult + go_kind k1 k2 + | tcEqForallVis k1 k2 = cteOK + | otherwise = forall_kind_vis_diff ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -321,6 +321,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "SkolemEscape" = 46956 GhcDiagnosticCode "DifferentTyVars" = 25897 GhcDiagnosticCode "RepresentationalEq" = 10283 + GhcDiagnosticCode "ForallKindVisDiff" = 11809 -- Typechecker/renamer diagnostic codes GhcDiagnosticCode "TcRnRedundantConstraints" = 30606 @@ -512,6 +513,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnUnexpectedDefaultSig" = 40700 GhcDiagnosticCode "TcRnBindInBootFile" = 11247 GhcDiagnosticCode "TcRnDuplicateMinimalSig" = 85346 + GhcDiagnosticCode "TcRnIncompatibleForallVisibility" = 25115 -- IllegalNewtypeReason GhcDiagnosticCode "DoesNotHaveSingleField" = 23517 ===================================== testsuite/tests/saks/should_fail/T18863a.stderr ===================================== @@ -1,5 +1,6 @@ -T18863a.hs:9:1: error: [GHC-83865] - • Couldn't match expected kind: forall i. i -> * - with actual kind: forall i -> i -> * +T18863a.hs:9:1: error: [GHC-25115] + • Visibility of forall-bound variables is not compatible + Expected: forall i -> i -> * + Actual: forall i. i -> * • In the data type declaration for ‘IDa’ ===================================== testsuite/tests/typecheck/should_compile/T22762.hs ===================================== @@ -0,0 +1,20 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +module T22762 where + +import Data.Kind + +type Const :: a -> b -> a +type family Const x y where + Const x _ = x + +type F :: (forall (b :: Bool) -> Const Type b) -> Type +data F f + +type G :: forall (b :: Bool) -> Type +data G b + +type H :: Type +type family H where + H = F G ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -857,3 +857,4 @@ test('T22647', normal, compile, ['']) test('T19577', normal, compile, ['']) test('T22383', normal, compile, ['']) test('T21501', normal, compile, ['']) +test('T22762', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/VisFlag1.hs ===================================== @@ -0,0 +1,18 @@ +module VisFlag1 where + +import Data.Kind (Type) + +type V :: forall k -> k -> Type +data V k (a :: k) = MkV + +f :: forall {k} {a :: k} (hk :: forall j. j -> Type). hk a -> () +f _ = () + +bad_tyapp :: () +bad_tyapp = f @V MkV + +bad_wild :: () +bad_wild = f @_ MkV + +bad_infer :: () +bad_infer = f MkV ===================================== testsuite/tests/typecheck/should_fail/VisFlag1.stderr ===================================== @@ -0,0 +1,26 @@ + +VisFlag1.hs:12:16: error: [GHC-25115] + • Visibilities of forall-bound variables are not compatible + Expected: forall j. j -> * + Actual: forall k -> k -> * + • In the type ‘V’ + In the expression: f @V MkV + In an equation for ‘bad_tyapp’: bad_tyapp = f @V MkV + +VisFlag1.hs:15:15: error: [GHC-91028] + • Expected kind ‘forall j. j -> *’, but ‘_’ has kind ‘k0’ + Cannot instantiate unification variable ‘k0’ + with a kind involving polytypes: forall j. j -> * + • In the expression: f @_ MkV + In an equation for ‘bad_wild’: bad_wild = f @_ MkV + +VisFlag1.hs:18:15: error: [GHC-11809] + • Couldn't match type ‘hk0’ with ‘V’ + Expected: hk0 a0 + Actual: V k1 a0 + Visibilities of forall-bound variables in kinds differ + hk0 :: forall j. j -> * + V :: forall k -> k -> * + • In the first argument of ‘f’, namely ‘MkV’ + In the expression: f MkV + In an equation for ‘bad_infer’: bad_infer = f MkV ===================================== testsuite/tests/typecheck/should_fail/VisFlag1_ql.hs ===================================== @@ -0,0 +1,20 @@ +{-# LANGUAGE ImpredicativeTypes #-} + +module VisFlag1_ql where + +import Data.Kind (Type) + +type V :: forall k -> k -> Type +data V k (a :: k) = MkV + +f :: forall {k} {a :: k} (hk :: forall j. j -> Type). hk a -> () +f _ = () + +bad_tyapp :: () +bad_tyapp = f @V MkV + +bad_wild :: () +bad_wild = f @_ MkV + +bad_infer :: () +bad_infer = f MkV ===================================== testsuite/tests/typecheck/should_fail/VisFlag1_ql.stderr ===================================== @@ -0,0 +1,23 @@ + +VisFlag1_ql.hs:14:16: error: [GHC-25115] + • Visibilities of forall-bound variables are not compatible + Expected: forall j. j -> * + Actual: forall k -> k -> * + • In the type ‘V’ + In the expression: f @V MkV + In an equation for ‘bad_tyapp’: bad_tyapp = f @V MkV + +VisFlag1_ql.hs:17:15: error: [GHC-91028] + • Expected kind ‘forall j. j -> *’, but ‘_’ has kind ‘k0’ + Cannot instantiate unification variable ‘k0’ + with a kind involving polytypes: forall j. j -> * + • In the expression: f @_ MkV + In an equation for ‘bad_wild’: bad_wild = f @_ MkV + +VisFlag1_ql.hs:20:15: error: [GHC-25115] + • Visibilities of forall-bound variables are not compatible + Expected: forall j. j -> * + Actual: forall k -> k -> * + • In the first argument of ‘f’, namely ‘MkV’ + In the expression: f MkV + In an equation for ‘bad_infer’: bad_infer = f MkV ===================================== testsuite/tests/typecheck/should_fail/VisFlag2.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + +module VisFlag2 where + +import Data.Kind (Type) + +-- the (Type ->) parameter is to prevent instantiation of invisible variables + +type family Invis :: Type -> forall a. a +type family Vis :: Type -> forall a -> a + +type instance Vis = Invis -- Bad +type instance Invis = Vis -- Bad ===================================== testsuite/tests/typecheck/should_fail/VisFlag2.stderr ===================================== @@ -0,0 +1,14 @@ + +VisFlag2.hs:13:21: error: [GHC-25115] + • Visibilities of forall-bound variables are not compatible + Expected: * -> forall a -> a + Actual: * -> forall a. a + • In the type ‘Invis’ + In the type instance declaration for ‘Vis’ + +VisFlag2.hs:14:23: error: [GHC-25115] + • Visibilities of forall-bound variables are not compatible + Expected: * -> forall a. a + Actual: * -> forall a -> a + • In the type ‘Vis’ + In the type instance declaration for ‘Invis’ ===================================== testsuite/tests/typecheck/should_fail/VisFlag3.hs ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE TypeFamilies #-} + +module VisFlag3 where + +class C (hk :: forall k. k -> k) where + type F (hk :: forall k -> k -> k) ===================================== testsuite/tests/typecheck/should_fail/VisFlag3.stderr ===================================== @@ -0,0 +1,6 @@ + +VisFlag3.hs:6:3: error: [GHC-25115] + • Visibilities of forall-bound variables are not compatible + Expected: forall k. k -> k + Actual: forall k -> k -> k + • In the associated type family declaration for ‘F’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -667,3 +667,7 @@ test('T22570', normal, compile_fail, ['']) test('T22645', normal, compile_fail, ['']) test('T20666', normal, compile_fail, ['']) test('T20666a', normal, compile_fail, ['']) +test('VisFlag1', normal, compile_fail, ['']) +test('VisFlag1_ql', normal, compile_fail, ['']) +test('VisFlag2', normal, compile_fail, ['']) +test('VisFlag3', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c08a6e9f9e828516dd78cb55433d4faf7b764cc7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c08a6e9f9e828516dd78cb55433d4faf7b764cc7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Feb 5 17:03:49 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sun, 05 Feb 2023 12:03:49 -0500 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] 3 commits: Safer Eq StackSnapshot Message-ID: <63dfe17522270_1108fe5263497582b@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: efc98054 by Sven Tennie at 2023-02-05T15:00:47+00:00 Safer Eq StackSnapshot - - - - - 8704428f by Sven Tennie at 2023-02-05T15:09:45+00:00 Revert useless changes - - - - - 02ec1349 by Sven Tennie at 2023-02-05T17:03:23+00:00 Revert unnecessary changes - - - - - 5 changed files: - libraries/base/GHC/Stack/CloneStack.hs - libraries/base/cbits/StackCloningDecoding.cmm - libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc - rts/Heap.c - rts/PrimOps.cmm Changes: ===================================== libraries/base/GHC/Stack/CloneStack.hs ===================================== @@ -50,7 +50,7 @@ stackSnapshotToWord :: StackSnapshot -> Word stackSnapshotToWord (StackSnapshot s#) = W# (stackSnapshotToWord# s#) instance Eq StackSnapshot where - s1 == s2 = stackSnapshotToWord s1 == stackSnapshotToWord s2 + (StackSnapshot s1#) == (StackSnapshot s2#) = (W# (eqStacks# s1# s2#)) > 0 foreign import prim "stg_decodeStackzh" decodeStack# :: StackSnapshot# -> State# RealWorld -> (# State# RealWorld, Array# (Ptr InfoProvEnt) #) @@ -60,6 +60,8 @@ foreign import prim "stg_sendCloneStackMessagezh" sendCloneStackMessage# :: Thre foreign import prim "stackSnapshotToWordzh" stackSnapshotToWord# :: StackSnapshot# -> Word# +foreign import prim "eqStackszh" eqStacks# :: StackSnapshot# -> StackSnapshot# -> Word# + {- Note [Stack Cloning] ~~~~~~~~~~~~~~~~~~~~ ===================================== libraries/base/cbits/StackCloningDecoding.cmm ===================================== @@ -29,3 +29,7 @@ stg_decodeStackzh (gcptr stgStack) { stackSnapshotToWordzh(P_ stack) { return (stack); } + +eqStackszh(P_ stack1, P_ stack2) { + return (stack1 == stack2); +} ===================================== libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc ===================================== @@ -1,6 +1,5 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} -{-# LANGUAGE BangPatterns #-} module GHC.Exts.Heap.FFIClosures_ProfilingDisabled where @@ -15,7 +14,6 @@ import GHC.Exts import GHC.Exts.Heap.ProfInfo.PeekProfInfo import GHC.Exts.Heap.ProfInfo.Types import GHC.Exts.Heap.Closures(WhatNext(..), WhyBlocked(..), TsoFlags(..)) -import Numeric data TSOFields = TSOFields { tso_what_next :: WhatNext, @@ -104,11 +102,10 @@ data StackFields = StackFields { #if __GLASGOW_HASKELL__ >= 811 stack_marking :: Word8, #endif - stack_sp :: Addr##, - stack_stack :: Addr## + stack_sp :: Addr## } --- | Get fields from @StgStack_@ (@TSO.h@) +-- | Get non-closure fields from @StgStack_@ (@TSO.h@) peekStackFields :: Ptr a -> IO StackFields peekStackFields ptr = do stack_size' <- (#peek struct StgStack_, stack_size) ptr ::IO Word32 @@ -117,7 +114,8 @@ peekStackFields ptr = do marking' <- (#peek struct StgStack_, marking) ptr #endif Ptr sp' <- (#peek struct StgStack_, sp) ptr - let !(Ptr stack') = (#ptr struct StgStack_, stack) ptr + + -- TODO decode the stack. return StackFields { stack_size = stack_size', @@ -125,9 +123,6 @@ peekStackFields ptr = do #if __GLASGOW_HASKELL__ >= 811 stack_marking = marking', #endif - stack_sp = sp', - stack_stack = stack' + stack_sp = sp' } -showAddr## :: Addr## -> String -showAddr## addr## = (showHex $ I## (addr2Int## addr##)) "" ===================================== rts/Heap.c ===================================== @@ -12,7 +12,6 @@ #include "Capability.h" #include "Printer.h" -#include "rts/storage/InfoTables.h" StgWord heap_view_closureSize(StgClosure *closure) { ASSERT(LOOKS_LIKE_CLOSURE_PTR(closure)); @@ -257,6 +256,7 @@ StgWord collect_pointers(StgClosure *closure, StgClosure *ptrs[]) { StgMutArrPtrs *heap_view_closurePtrs(Capability *cap, StgClosure *closure) { ASSERT(LOOKS_LIKE_CLOSURE_PTR(closure)); + StgWord size = heap_view_closureSize(closure); // First collect all pointers here, with the comfortable memory bound ===================================== rts/PrimOps.cmm ===================================== @@ -2513,6 +2513,7 @@ stg_unpackClosurezh ( P_ closure ) W_ clos; clos = UNTAG(closure); + W_ len; // The array returned, dat_arr, is the raw data for the entire closure. // The length is variable based upon the closure type, ptrs, and non-ptrs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae0d6694b68983c7b4b098451e2b59a466ec8cd4...02ec1349dd711c4623a041ad0afef90b121d5bee -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae0d6694b68983c7b4b098451e2b59a466ec8cd4...02ec1349dd711c4623a041ad0afef90b121d5bee You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Feb 5 19:21:09 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sun, 05 Feb 2023 14:21:09 -0500 Subject: [Git][ghc/ghc][wip/int-index/visibility-check] Fix a test Message-ID: <63e001a5c660_1108fe193a739898746c@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/visibility-check at Glasgow Haskell Compiler / GHC Commits: 69f1c6f0 by Vladislav Zavialov at 2023-02-05T22:21:00+03:00 Fix a test - - - - - 1 changed file: - testsuite/tests/saks/should_fail/T18863a.stderr Changes: ===================================== testsuite/tests/saks/should_fail/T18863a.stderr ===================================== @@ -1,6 +1,6 @@ T18863a.hs:9:1: error: [GHC-25115] - • Visibility of forall-bound variables is not compatible + • Visibilities of forall-bound variables are not compatible Expected: forall i -> i -> * Actual: forall i. i -> * • In the data type declaration for ‘IDa’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/69f1c6f01187411c45ddaea3cb41596b058f611e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/69f1c6f01187411c45ddaea3cb41596b058f611e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Feb 5 23:32:49 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sun, 05 Feb 2023 18:32:49 -0500 Subject: [Git][ghc/ghc][wip/int-index/visibility-check] Apply 7 suggestion(s) to 2 file(s) Message-ID: <63e03ca1ac709_1108fe526489964d4@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/visibility-check at Glasgow Haskell Compiler / GHC Commits: 60cf227e by Ryan Scott at 2023-02-05T23:32:47+00:00 Apply 7 suggestion(s) to 2 file(s) - - - - - 2 changed files: - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Tc/Utils/TcMType.hs Changes: ===================================== compiler/GHC/Core/TyCo/Compare.hs ===================================== @@ -246,7 +246,7 @@ When we compare (ForAllTy (Bndr tv1 vis1) ty1) what should we do about `vis1` vs `vis2`? One option is to take those flags into account and check (vis1==vis2). -But in Core visibility of forall-bound variables has no meaning, +But in Core, the visibilities of forall-bound variables have no meaning, as type abstraction and type application are always explicit. Going to great lengths to carry them around is counterproductive, but not going far enough may lead to Core Lint errors (#22762). @@ -255,13 +255,13 @@ The other option (the one we take) is to ignore those flags. Neither the name of a forall-bound variable nor its visibility flag affect GHC's notion of type equality. -That said, in user-written programs visibility of foralls does matter -a great deal. For example, if we unify tv := T, where +That said, the visibilities of foralls do matter +a great deal in user-written programs. For example, if we unify tv := T, where tv :: forall k. k -> Type T :: forall k -> k -> Type -then the user can not substitute `T Maybe` for `tv Maybe` in their program +then the user cannot substitute `T Maybe` for `tv Maybe` in their program by hand. They'd have to write `T (Type -> Type) Maybe` instead. -This entails loss referential transparency. We solve this issue by +This entails a loss of referential transparency. We solve this issue by checking the flags *outside* the equality relation. To that end, there are two ad-hoc checks: * checkEqForallVis (in checking mode) @@ -271,8 +271,7 @@ These checks use `eqForAllVis` to compare the `ForAllTyFlag`s. But should we perhaps use (==) instead? Do we only care about visibility (Required vs Invisible) or do we also care about specificity (Specified vs Inferred)? - -Should GHC type-check the following program (adapted from #15740)? +For example, should GHC type-check the following program (adapted from #15740)? {-# LANGUAGE PolyKinds, ... #-} data D a ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -614,7 +614,7 @@ tc_infer mb_frr tc_check * * ********************************************************************* -} --- Check if two presumably equal types actually differ in visibility +-- Check if two presumably equal types actually differ in the visibility -- of their foralls. Example (from #18863): -- -- type IDa :: forall i -> i -> Type @@ -630,7 +630,7 @@ checkEqForallVis ty1 (Check ty2) = addErr $ TcRnIncompatibleForallVisibility ty1 ty2 -- Structurally match two presumably equal types, checking that all pairs of --- foralls have equal visibility. +-- foralls have equal visibilities. -- -- See Note [Presumably equal types] tcEqForallVis :: Type -> Type -> Bool View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/60cf227ee77c7bbf18e53fccb593368882ad3b2e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/60cf227ee77c7bbf18e53fccb593368882ad3b2e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Feb 5 23:52:11 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 05 Feb 2023 18:52:11 -0500 Subject: [Git][ghc/ghc][wip/T22883] base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Message-ID: <63e0412b5fccf_1108fe526201007431@gitlab.mail> Ben Gamari pushed to branch wip/T22883 at Glasgow Haskell Compiler / GHC Commits: 3051718c by Ben Gamari at 2023-02-05T18:52:06-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 1 changed file: - libraries/base/changelog.md Changes: ===================================== libraries/base/changelog.md ===================================== @@ -1,6 +1,7 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) ## 4.18.0.0 *TBA* + * `Foreign.C.ConstPtr.ConstrPtr` was added to encode `const`-qualified pointer types in foreign declarations when using `CApiFFI` extension. ([CLC proposal #117](https://github.com/haskell/core-libraries-committee/issues/117)) * Add `forall a. Functor (p a)` superclass for `Bifunctor p` ([CLC proposal #91](https://github.com/haskell/core-libraries-committee/issues/91)) @@ -66,6 +67,13 @@ * 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. + * Various declarations GHC's new info-table provenance feature have been + moved from `GHC.Stack.CCS` to a new `GHC.InfoProv` module: + * The `InfoProv`, along its `ipName`, `ipDesc`, `ipTyDesc`, `ipLabel`, + `ipMod`, and `ipLoc` fields, have been moved. + * `InfoProv` now has additional `ipSrcFile` and `ipSrcSpan` fields. `ipLoc` + is now a function computed from these fields. + * The `whereFrom` function has been moved ## 4.17.0.0 *August 2022* View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3051718c12849c96d049aec2a5b06e237f38aa35 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3051718c12849c96d049aec2a5b06e237f38aa35 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 00:11:21 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sun, 05 Feb 2023 19:11:21 -0500 Subject: [Git][ghc/ghc][wip/int-index/visibility-check] Ignore forall visibility in eqType (#22762) Message-ID: <63e045a9373b_1108fe2b215ec810113c1@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/visibility-check at Glasgow Haskell Compiler / GHC Commits: 24583c75 by Vladislav Zavialov at 2023-02-06T03:06:32+03:00 Ignore forall visibility in eqType (#22762) Prior to this change, the equality relation on types took ForAllTyFlag into account, making a distinction between: 1. forall a. blah 2. forall a -> blah Not anymore. This distinction is important in surface Haskell, but it has no meaning in Core where type abstraction and type application are always explicit. At the same time, if we are not careful to track this flag, Core Lint will fail, as reported in #22762: *** Core Lint errors : in result of TcGblEnv axioms *** From-kind of Cast differs from kind of enclosed type From-kind: forall (b :: Bool) -> * Kind of enclosed type: forall {b :: Bool}. * The solution is to compare types for equality modulo visibility (ForAllTyFlag). Updated functions: nonDetCmpType (worker for eqType) eqDeBruijnType tc_eq_type (worker for tcEqType) can_eq_nc In order to retain the distinction between visible and invisible forall in user-written code, we introduce new ad-hoc checks: checkEqForallVis (in checking mode) cteForallKindVisDiff (in inference mode) - - - - - 24 changed files: - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Types/Error/Codes.hs - testsuite/tests/saks/should_fail/T18863a.stderr - + testsuite/tests/typecheck/should_compile/T22762.hs - testsuite/tests/typecheck/should_compile/all.T - + testsuite/tests/typecheck/should_fail/VisFlag1.hs - + testsuite/tests/typecheck/should_fail/VisFlag1.stderr - + testsuite/tests/typecheck/should_fail/VisFlag1_ql.hs - + testsuite/tests/typecheck/should_fail/VisFlag1_ql.stderr - + testsuite/tests/typecheck/should_fail/VisFlag2.hs - + testsuite/tests/typecheck/should_fail/VisFlag2.stderr - + testsuite/tests/typecheck/should_fail/VisFlag3.hs - + testsuite/tests/typecheck/should_fail/VisFlag3.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Core/Map/Type.hs ===================================== @@ -38,7 +38,6 @@ import GHC.Prelude import GHC.Core.Type import GHC.Core.Coercion import GHC.Core.TyCo.Rep -import GHC.Core.TyCo.Compare( eqForAllVis ) import GHC.Data.TrieMap import GHC.Data.FastString @@ -261,11 +260,9 @@ eqDeBruijnType env_t1@(D env1 t1) env_t2@(D env2 t2) = -> liftEquality (tc == tc') `andEq` gos env env' tys tys' (LitTy l, LitTy l') -> liftEquality (l == l') - (ForAllTy (Bndr tv vis) ty, ForAllTy (Bndr tv' vis') ty') - -> -- See Note [ForAllTy and type equality] in - -- GHC.Core.TyCo.Compare for why we use `eqForAllVis` here - liftEquality (vis `eqForAllVis` vis') `andEq` - go (D env (varType tv)) (D env' (varType tv')) `andEq` + (ForAllTy (Bndr tv _) ty, ForAllTy (Bndr tv' _) ty') + -- Ignore ForAllTyFlag. See Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare + -> go (D env (varType tv)) (D env' (varType tv')) `andEq` go (D (extendCME env tv) ty) (D (extendCME env' tv') ty') (CoercionTy {}, CoercionTy {}) -> TEQ ===================================== compiler/GHC/Core/TyCo/Compare.hs ===================================== @@ -16,7 +16,7 @@ module GHC.Core.TyCo.Compare ( tcEqTyConApps, -- * Visiblity comparision - eqForAllVis, cmpForAllVis + eqForAllVis, ) where @@ -171,11 +171,13 @@ tc_eq_type keep_syns vis_only orig_ty1 orig_ty2 go _ (LitTy lit1) (LitTy lit2) = lit1 == lit2 - go env (ForAllTy (Bndr tv1 vis1) ty1) - (ForAllTy (Bndr tv2 vis2) ty2) - = vis1 `eqForAllVis` vis2 - && (vis_only || go env (varType tv1) (varType tv2)) - && go (rnBndr2 env tv1 tv2) ty1 ty2 + go env (ForAllTy (Bndr tv1 _) ty1) + (ForAllTy (Bndr tv2 _) ty2) + -- Ignore ForAllTyFlag. See Note [ForAllTy and type equality] + = kinds_eq && go (rnBndr2 env tv1 tv2) ty1 ty2 + where + kinds_eq | vis_only = True + | otherwise = go env (varType tv1) (varType tv2) -- Make sure we handle all FunTy cases since falling through to the -- AppTy case means that tcSplitAppTyNoView_maybe may see an unzonked @@ -227,7 +229,9 @@ tc_eq_type keep_syns vis_only orig_ty1 orig_ty2 -- | Do these denote the same level of visibility? 'Required' -- arguments are visible, others are not. So this function --- equates 'Specified' and 'Inferred'. Used for printing. +-- equates 'Specified' and 'Inferred'. +-- +-- Used for printing and in tcEqForallVis. eqForAllVis :: ForAllTyFlag -> ForAllTyFlag -> Bool -- See Note [ForAllTy and type equality] -- If you change this, see IMPORTANT NOTE in the above Note @@ -235,28 +239,39 @@ eqForAllVis Required Required = True eqForAllVis (Invisible _) (Invisible _) = True eqForAllVis _ _ = False --- | Do these denote the same level of visibility? 'Required' --- arguments are visible, others are not. So this function --- equates 'Specified' and 'Inferred'. Used for printing. -cmpForAllVis :: ForAllTyFlag -> ForAllTyFlag -> Ordering --- See Note [ForAllTy and type equality] --- If you change this, see IMPORTANT NOTE in the above Note -cmpForAllVis Required Required = EQ -cmpForAllVis Required (Invisible {}) = LT -cmpForAllVis (Invisible _) Required = GT -cmpForAllVis (Invisible _) (Invisible _) = EQ - - {- Note [ForAllTy and type equality] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When we compare (ForAllTy (Bndr tv1 vis1) ty1) and (ForAllTy (Bndr tv2 vis2) ty2) -what should we do about `vis1` vs `vis2`. - -First, we always compare with `eqForAllVis` and `cmpForAllVis`. -But what decision do we make? - -Should GHC type-check the following program (adapted from #15740)? +what should we do about `vis1` vs `vis2`? + +One option is to take those flags into account and check (vis1==vis2). +But in Core, the visibilities of forall-bound variables have no meaning, +as type abstraction and type application are always explicit. +Going to great lengths to carry them around is counterproductive, +but not going far enough may lead to Core Lint errors (#22762). + +The other option (the one we take) is to ignore those flags. +Neither the name of a forall-bound variable nor its visibility flag +affect GHC's notion of type equality. + +That said, the visibilities of foralls do matter +a great deal in user-written programs. For example, if we unify tv := T, where + tv :: forall k. k -> Type + T :: forall k -> k -> Type +then the user cannot substitute `T Maybe` for `tv Maybe` in their program +by hand. They'd have to write `T (Type -> Type) Maybe` instead. +This entails a loss of referential transparency. We solve this issue by +checking the flags *outside* the equality relation. To that end, +there are two ad-hoc checks: + * checkEqForallVis (in checking mode) + * cteForallKindVisDiff (in inference mode) + +These checks use `eqForAllVis` to compare the `ForAllTyFlag`s. +But should we perhaps use (==) instead? +Do we only care about visibility (Required vs Invisible) +or do we also care about specificity (Specified vs Inferred)? +For example, should GHC type-check the following program (adapted from #15740)? {-# LANGUAGE PolyKinds, ... #-} data D a @@ -280,12 +295,7 @@ programs like the one above. Whether a kind variable binder ends up being specified or inferred can be somewhat subtle, however, especially for kinds that aren't explicitly written out in the source code (like in D above). -For now, we decide - - the specified/inferred status of an invisible type variable binder - does not affect GHC's notion of equality. - -That is, we have the following: +For now, we decide to ignore specificity. That is, we have the following: -------------------------------------------------- | Type 1 | Type 2 | Equal? | @@ -303,11 +313,9 @@ That is, we have the following: | | forall k -> <...> | Yes | -------------------------------------------------- -IMPORTANT NOTE: if we want to change this decision, ForAllCo will need to carry -visiblity (by taking a ForAllTyBinder rathre than a TyCoVar), so that -coercionLKind/RKind build forall types that match (are equal to) the desired -ones. Otherwise we get an infinite loop in the solver via canEqCanLHSHetero. -Examples: T16946, T15079. +One unfortunate consequence of this setup is that it can be exploited +to observe the order of inferred quantification (#22648). However, fixing this +would be a breaking change, so we choose not to (at least for now). Historical Note [Typechecker equality vs definitional equality] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -335,7 +343,7 @@ is more finer-grained than definitional equality in two places: Constraint, but typechecker treats them as distinct types. * Unlike definitional equality, which does not care about the ForAllTyFlag of a - ForAllTy, typechecker equality treats Required type variable binders as + ForAllTy, typechecker equality treated Required type variable binders as distinct from Invisible type variable binders. See Note [ForAllTy and type equality] @@ -513,9 +521,9 @@ nonDetCmpTypeX env orig_t1 orig_t2 = go env (TyVarTy tv1) (TyVarTy tv2) = liftOrdering $ rnOccL env tv1 `nonDetCmpVar` rnOccR env tv2 - go env (ForAllTy (Bndr tv1 vis1) t1) (ForAllTy (Bndr tv2 vis2) t2) - = liftOrdering (vis1 `cmpForAllVis` vis2) - `thenCmpTy` go env (varType tv1) (varType tv2) + go env (ForAllTy (Bndr tv1 _) t1) (ForAllTy (Bndr tv2 _) t2) + -- Ignore ForAllTyFlag. See Note [ForAllTy and type equality] + = go env (varType tv1) (varType tv2) `thenCmpTy` go (rnBndr2 env tv1 tv2) t1 t2 -- See Note [Equality on AppTys] ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -1673,6 +1673,16 @@ mkTyVarEqErr' ctxt item (tv1, co1) ty2 -- to be helpful since this is just an unimplemented feature. return (main_msg, []) + -- The kinds of 'tv1' and 'ty2' contain forall-bound variables that + -- differ in visibility (ForAllTyFlag). + | check_eq_result `cterHasProblem` cteForallKindVisDiff + = let reason = ForallKindVisDiff tv1 ty2 + main_msg = + CannotUnifyVariable + { mismatchMsg = headline_msg + , cannotUnifyReason = reason } + in return (main_msg, []) + | isSkolemTyVar tv1 -- ty2 won't be a meta-tyvar; we would have -- swapped in Solver.Canonical.canEqTyVarHomo || isTyVarTyVar tv1 && not (isTyVarTy ty2) ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1226,6 +1226,12 @@ instance Diagnostic TcRnMessage where TcRnSectionWithoutParentheses expr -> mkSimpleDecorated $ hang (text "A section must be enclosed in parentheses") 2 (text "thus:" <+> (parens (ppr expr))) + TcRnIncompatibleForallVisibility act exp -> + mkSimpleDecorated $ + hang (text "Visibilities of forall-bound variables are not compatible") 2 $ + vcat + [ text "Expected:" <+> ppr exp + , text " Actual:" <+> ppr act ] TcRnCapturedTermName tv_name shadowed_term_names -> mkSimpleDecorated $ @@ -1734,6 +1740,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnDuplicateMinimalSig{} -> ErrorWithoutFlag + TcRnIncompatibleForallVisibility{} + -> ErrorWithoutFlag diagnosticHints = \case TcRnUnknownMessage m @@ -2173,6 +2181,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnDuplicateMinimalSig{} -> noHints + TcRnIncompatibleForallVisibility{} + -> noHints diagnosticCode = constructorCode @@ -2970,6 +2980,10 @@ pprCannotUnifyVariableReason ctxt (DifferentTyVars tv_info) pprCannotUnifyVariableReason ctxt (RepresentationalEq tv_info mb_coercible_msg) = pprTyVarInfo ctxt tv_info $$ maybe empty pprCoercibleMsg mb_coercible_msg +pprCannotUnifyVariableReason _ (ForallKindVisDiff tv1 ty2) + = hang (text "Visibilities of forall-bound variables in kinds differ") 2 $ + vcat [ ppr tv1 <+> text "::" <+> ppr (tyVarKind tv1) + , ppr ty2 <+> text "::" <+> ppr (typeKind ty2) ] pprMismatchMsg :: SolverReportErrCtxt -> MismatchMsg -> SDoc pprMismatchMsg ctxt ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -2924,6 +2924,22 @@ data TcRnMessage where -} TcRnDuplicateMinimalSig :: LSig GhcPs -> LSig GhcPs -> [LSig GhcPs] -> TcRnMessage + {-| TcRnIncompatibleForallVisibility is an error that occurs when + the expected and actual types contain forall-bound variables + that have incompatible visibilities. + + Example: + type family Invis :: Type -> forall a. a + type family Vis :: Type -> forall a -> a + type instance Vis = Invis -- Bad instance + + Test cases: T18863a VisFlag1 VisFlag1_ql VisFlag2 VisFlag3 + -} + TcRnIncompatibleForallVisibility + :: TcType + -> TcType + -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. @@ -3787,6 +3803,20 @@ data CannotUnifyVariableReason -- type Int, or with a 'TyVarTv'. | DifferentTyVars TyVarInfo | RepresentationalEq TyVarInfo (Maybe CoercibleMsg) + + -- | Can't unify a kind-polymorphic type variable with a type + -- due to differences in visibility between forall-bound variables in their kinds. + -- + -- Example: + -- data V k (a :: k) = MkV + -- f :: forall {k} {a :: k} (hk :: forall j. j -> Type). hk a -> () + -- bad_infer = f MkV + -- -- we want to unify hk := V + -- -- but hk :: forall j. j -> Type + -- -- V :: forall k -> k -> Type + -- + -- Test cases: VisFlag1 + | ForallKindVisDiff TyVar Type deriving Generic -- | Report a mismatch error without any extra ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -361,7 +361,8 @@ tcApp rn_expr exp_res_ty -- app_res_rho and exp_res_ty are both rho-types, -- so with simple subsumption we can just unify them -- No need to zonk; the unifier does that - do { co <- unifyExpectedType rn_expr app_res_rho exp_res_ty + do { checkEqForallVis app_res_rho exp_res_ty + ; co <- unifyExpectedType rn_expr app_res_rho exp_res_ty ; return (mkWpCastN co) } else -- Deep subsumption @@ -371,6 +372,7 @@ tcApp rn_expr exp_res_ty -- Zonk app_res_rho first, because QL may have instantiated some -- delta variables to polytypes, and tcSubType doesn't expect that do { app_res_rho <- zonkQuickLook do_ql app_res_rho + ; checkEqForallVis app_res_rho exp_res_ty ; tcSubTypeDS rn_expr app_res_rho exp_res_ty } -- Typecheck the value arguments @@ -1050,9 +1052,9 @@ qlUnify delta ty1 ty2 -- Passes the occurs check = do { let ty2_kind = typeKind ty2 kappa_kind = tyVarKind kappa + ; checkEqForallVis ty2_kind (Check kappa_kind) ; co <- unifyKind (Just (TypeThing ty2)) ty2_kind kappa_kind -- unifyKind: see Note [Actual unification in qlUnify] - ; traceTc "qlUnify:update" $ vcat [ hang (ppr kappa <+> dcolon <+> ppr kappa_kind) 2 (text ":=" <+> ppr ty2 <+> dcolon <+> ppr ty2_kind) ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -1931,6 +1931,7 @@ checkExpectedKind hs_ty ty act_kind exp_kind ; let res_ty = ty `mkAppTys` new_args + ; checkEqForallVis act_kind' (mkCheckExpType exp_kind) ; if act_kind' `tcEqType` exp_kind then return res_ty -- This is very common else do { co_k <- uType KindLevel origin act_kind' exp_kind @@ -2552,6 +2553,7 @@ kcCheckDeclHeader_sig sig_kind name flav ; case ctx_k of AnyKind -> return () -- No signature _ -> do { res_ki <- newExpectedKind ctx_k + ; checkEqForallVis res_ki (mkCheckExpType sig_res_kind') ; discardResult (unifyKind Nothing sig_res_kind' res_ki) } -- Add more binders for data/newtype, so the result kind has no arrows @@ -3284,6 +3286,7 @@ bindExplicitTKBndrsX skol_mode@(SM { sm_parent = check_parent, sm_kind = ctxt_ki | check_parent , Just (ATyVar _ tv) <- lookupNameEnv lcl_env name = do { kind <- tc_lhs_kind_sig tc_ki_mode (TyVarBndrKindCtxt name) lhs_kind + ; checkEqForallVis kind (Check (tyVarKind tv)) ; discardResult $ unifyKind (Just . NameThing $ name) kind (tyVarKind tv) -- This unify rejects: ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -1095,9 +1095,9 @@ can_eq_nc' rewritten _rdr_env _envs ev eq_rel ty1 _ ty2 _ = canTyConApp rewritten ev eq_rel tc1 tys1 tc2 tys2 can_eq_nc' _rewritten _rdr_env _envs ev eq_rel - s1@(ForAllTy (Bndr _ vis1) _) _ - s2@(ForAllTy (Bndr _ vis2) _) _ - | vis1 `eqForAllVis` vis2 -- Note [ForAllTy and type equality] + s1@(ForAllTy _ _) _ + s2@(ForAllTy _ _) _ + -- Ignore ForAllTyFlag. See Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare = can_eq_nc_forall ev eq_rel s1 s2 -- See Note [Canonicalising type applications] about why we require rewritten types ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -34,6 +34,7 @@ module GHC.Tc.Types.Constraint ( CheckTyEqResult, CheckTyEqProblem, cteProblem, cterClearOccursCheck, cteOK, cteImpredicative, cteTypeFamily, cteInsolubleOccurs, cteSolubleOccurs, cterSetOccursCheckSoluble, + cteForallKindVisDiff, cterHasNoProblem, cterHasProblem, cterHasOnlyProblem, cterRemoveProblem, cterHasOccursCheck, cterFromKind, @@ -452,12 +453,13 @@ cterHasNoProblem _ = False -- | An individual problem that might be logged in a 'CheckTyEqResult' newtype CheckTyEqProblem = CTEP Word8 -cteImpredicative, cteTypeFamily, cteInsolubleOccurs, cteSolubleOccurs :: CheckTyEqProblem +cteImpredicative, cteTypeFamily, cteInsolubleOccurs, cteSolubleOccurs, cteForallKindVisDiff :: CheckTyEqProblem cteImpredicative = CTEP (bit 0) -- forall or (=>) encountered cteTypeFamily = CTEP (bit 1) -- type family encountered cteInsolubleOccurs = CTEP (bit 2) -- occurs-check cteSolubleOccurs = CTEP (bit 3) -- occurs-check under a type function or in a coercion -- must be one bit to the left of cteInsolubleOccurs +cteForallKindVisDiff = CTEP (bit 4) -- differing visibility of forall-bound variables in the kind -- See also Note [Insoluble occurs check] in GHC.Tc.Errors cteProblem :: CheckTyEqProblem -> CheckTyEqResult @@ -521,7 +523,8 @@ instance Outputable CheckTyEqResult where all_bits = [ (cteImpredicative, "cteImpredicative") , (cteTypeFamily, "cteTypeFamily") , (cteInsolubleOccurs, "cteInsolubleOccurs") - , (cteSolubleOccurs, "cteSolubleOccurs") ] + , (cteSolubleOccurs, "cteSolubleOccurs") + , (cteForallKindVisDiff, "cteForallKindVisDiff") ] set_bits = [ text str | (bitmask, str) <- all_bits , cter `cterHasProblem` bitmask ] ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -66,6 +66,10 @@ module GHC.Tc.Utils.TcMType ( checkingExpType_maybe, checkingExpType, inferResultToType, ensureMonoType, promoteTcType, + -------------------------------- + -- Visibility flag check + tcEqForallVis, checkEqForallVis, + -------------------------------- -- Zonking and tidying zonkTidyTcType, zonkTidyTcTypes, zonkTidyOrigin, zonkTidyOrigins, @@ -604,6 +608,108 @@ tc_infer mb_frr tc_check ; res_ty <- readExpType res_ty ; return (result, res_ty) } +{- ********************************************************************* +* * + Visibility flag check +* * +********************************************************************* -} + +-- Check if two presumably equal types actually differ in the visibility +-- of their foralls. Example (from #18863): +-- +-- type IDa :: forall i -> i -> Type +-- data IDa :: forall i. i -> Type +-- +-- Report TcRnIncompatibleForallVisibility if the visibilites differ, +-- as in the example above. +-- +-- See Note [Presumably equal types] +checkEqForallVis :: TcType -> ExpType -> TcM () +checkEqForallVis _ (Infer _) = return () +checkEqForallVis ty1 (Check ty2) = + unless (tcEqForallVis ty1 ty2) $ + addErr $ TcRnIncompatibleForallVisibility ty1 ty2 + +-- Structurally match two presumably equal types, checking that all pairs of +-- foralls have equal visibilities. +-- +-- See Note [Presumably equal types] +tcEqForallVis :: Type -> Type -> Bool +tcEqForallVis = matchUpForAllTyFlags eqForAllVis + +-- Structurally match two presumably equal types, checking that all pairs of +-- forall visibility flags (ForAllTyFlag) satisfy a predicate. +-- +-- For example, given the types +-- ty1 = forall a1. Bool -> forall b1. ... +-- ty2 = forall a2. Bool -> forall b2 -> ... +-- We have +-- matchUpForAllTyFlags f ty1 ty2 = +-- f Specified Specified && -- from (a1, a2) +-- f Specified Required -- from (b1, b2) +-- +-- Metavariables are of no interest to us: they stand for monotypes, so there +-- are no forall flags to be found. We do not look through metavariables. +-- +-- See Note [Presumably equal types] +matchUpForAllTyFlags + :: (ForAllTyFlag -> ForAllTyFlag -> Bool) + -> TcType -- actual + -> TcType -- expected + -> Bool +matchUpForAllTyFlags zip_flags actual expected = + go actual expected True + where + go :: TcType -> TcType -> Bool -> Bool + -- See Note [Comparing nullary type synonyms] in GHC.Core.Type + go (TyConApp tc1 []) (TyConApp tc2 []) cont | tc1 == tc2 = cont + + go t1 t2 cont | Just t1' <- coreView t1 = go t1' t2 cont + go t1 t2 cont | Just t2' <- coreView t2 = go t1 t2' cont + + go (LitTy lit1) (LitTy lit2) cont + | lit1 /= lit2 = True -- ex falso shortcut + | otherwise = cont + + go (ForAllTy (Bndr tv1 vis1) ty1) (ForAllTy (Bndr tv2 vis2) ty2) cont + = go (varType tv1) (varType tv2) $ + go ty1 ty2 $ + zip_flags vis1 vis2 && cont + + go (FunTy _ w1 arg1 res1) (FunTy _ w2 arg2 res2) cont = + go arg1 arg2 $ go res1 res2 $ go w1 w2 $ cont + go (AppTy s1 t1) (AppTy s2 t2) cont = + go s1 s2 $ go t1 t2 $ cont + go (TyConApp tc1 ts1) (TyConApp tc2 ts2) cont + | tc1 /= tc2 = True -- ex falso shortcut + | otherwise = gos ts1 ts2 cont + + go (CastTy t1 _) t2 cont = go t1 t2 cont + go t1 (CastTy t2 _) cont = go t1 t2 cont + go _ _ cont = cont + + gos (t1:ts1) (t2:ts2) cont = gos ts1 ts2 $ go t1 t2 cont + gos [] [] cont = cont + gos _ _ _ = True -- ex falso shortcut + +{- Note [Presumably equal types] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In matchUpForAllTyFlags (and by extension tcEqForallVis, checkEqForallVis) +we want to be checking the logical implication + (ty1 = ty2) ⊃ (forall flags satisfy the predicate) +If the assumption (ty1 = ty2) does not hold, the correct thing to do is to +return True (ex falso sequitur quodlibet). + +However, implementing these semantics precisely would make this function +more complicated and expensive. For instance, we'd have to maintain a RnEnv2 +to check type variables for equality. + +As a pragmatic compromise, we say that the result of matchUpForAllTyFlags is +not well-defined if (ty1 /= ty2). This should not matter in practice, as +those functions are only ever used in conjunction with an actual equality check. +The worst case scenario is that we report a less helpful error message. +-} + {- ********************************************************************* * * Promoting types ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -2636,12 +2636,14 @@ checkTypeEq :: CanEqLHS -> TcType -> CheckTyEqResult -- case-analysis on 'lhs') -- * checkEqCanLHSFinish, which does not know the form of 'lhs' checkTypeEq lhs ty - = go ty + = go ty S.<> + go_kind (canEqLHSKind lhs) (typeKind ty) where impredicative = cteProblem cteImpredicative type_family = cteProblem cteTypeFamily insoluble_occurs = cteProblem cteInsolubleOccurs soluble_occurs = cteProblem cteSolubleOccurs + forall_kind_vis_diff = cteProblem cteForallKindVisDiff -- The GHCi runtime debugger does its type-matching with -- unification variables that can unify with a polytype @@ -2721,3 +2723,8 @@ checkTypeEq lhs ty | ghci_tv = \ _tc -> cteOK | otherwise = \ tc -> (if isTauTyCon tc then cteOK else impredicative) S.<> (if isFamFreeTyCon tc then cteOK else type_family) + + go_kind :: TcKind -> TcKind -> CheckTyEqResult + go_kind k1 k2 + | tcEqForallVis k1 k2 = cteOK + | otherwise = forall_kind_vis_diff ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -321,6 +321,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "SkolemEscape" = 46956 GhcDiagnosticCode "DifferentTyVars" = 25897 GhcDiagnosticCode "RepresentationalEq" = 10283 + GhcDiagnosticCode "ForallKindVisDiff" = 11809 -- Typechecker/renamer diagnostic codes GhcDiagnosticCode "TcRnRedundantConstraints" = 30606 @@ -512,6 +513,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnUnexpectedDefaultSig" = 40700 GhcDiagnosticCode "TcRnBindInBootFile" = 11247 GhcDiagnosticCode "TcRnDuplicateMinimalSig" = 85346 + GhcDiagnosticCode "TcRnIncompatibleForallVisibility" = 25115 -- IllegalNewtypeReason GhcDiagnosticCode "DoesNotHaveSingleField" = 23517 ===================================== testsuite/tests/saks/should_fail/T18863a.stderr ===================================== @@ -1,5 +1,6 @@ -T18863a.hs:9:1: error: [GHC-83865] - • Couldn't match expected kind: forall i. i -> * - with actual kind: forall i -> i -> * +T18863a.hs:9:1: error: [GHC-25115] + • Visibilities of forall-bound variables are not compatible + Expected: forall i -> i -> * + Actual: forall i. i -> * • In the data type declaration for ‘IDa’ ===================================== testsuite/tests/typecheck/should_compile/T22762.hs ===================================== @@ -0,0 +1,20 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +module T22762 where + +import Data.Kind + +type Const :: a -> b -> a +type family Const x y where + Const x _ = x + +type F :: (forall (b :: Bool) -> Const Type b) -> Type +data F f + +type G :: forall (b :: Bool) -> Type +data G b + +type H :: Type +type family H where + H = F G ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -857,3 +857,4 @@ test('T22647', normal, compile, ['']) test('T19577', normal, compile, ['']) test('T22383', normal, compile, ['']) test('T21501', normal, compile, ['']) +test('T22762', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/VisFlag1.hs ===================================== @@ -0,0 +1,18 @@ +module VisFlag1 where + +import Data.Kind (Type) + +type V :: forall k -> k -> Type +data V k (a :: k) = MkV + +f :: forall {k} {a :: k} (hk :: forall j. j -> Type). hk a -> () +f _ = () + +bad_tyapp :: () +bad_tyapp = f @V MkV + +bad_wild :: () +bad_wild = f @_ MkV + +bad_infer :: () +bad_infer = f MkV ===================================== testsuite/tests/typecheck/should_fail/VisFlag1.stderr ===================================== @@ -0,0 +1,26 @@ + +VisFlag1.hs:12:16: error: [GHC-25115] + • Visibilities of forall-bound variables are not compatible + Expected: forall j. j -> * + Actual: forall k -> k -> * + • In the type ‘V’ + In the expression: f @V MkV + In an equation for ‘bad_tyapp’: bad_tyapp = f @V MkV + +VisFlag1.hs:15:15: error: [GHC-91028] + • Expected kind ‘forall j. j -> *’, but ‘_’ has kind ‘k0’ + Cannot instantiate unification variable ‘k0’ + with a kind involving polytypes: forall j. j -> * + • In the expression: f @_ MkV + In an equation for ‘bad_wild’: bad_wild = f @_ MkV + +VisFlag1.hs:18:15: error: [GHC-11809] + • Couldn't match type ‘hk0’ with ‘V’ + Expected: hk0 a0 + Actual: V k1 a0 + Visibilities of forall-bound variables in kinds differ + hk0 :: forall j. j -> * + V :: forall k -> k -> * + • In the first argument of ‘f’, namely ‘MkV’ + In the expression: f MkV + In an equation for ‘bad_infer’: bad_infer = f MkV ===================================== testsuite/tests/typecheck/should_fail/VisFlag1_ql.hs ===================================== @@ -0,0 +1,20 @@ +{-# LANGUAGE ImpredicativeTypes #-} + +module VisFlag1_ql where + +import Data.Kind (Type) + +type V :: forall k -> k -> Type +data V k (a :: k) = MkV + +f :: forall {k} {a :: k} (hk :: forall j. j -> Type). hk a -> () +f _ = () + +bad_tyapp :: () +bad_tyapp = f @V MkV + +bad_wild :: () +bad_wild = f @_ MkV + +bad_infer :: () +bad_infer = f MkV ===================================== testsuite/tests/typecheck/should_fail/VisFlag1_ql.stderr ===================================== @@ -0,0 +1,23 @@ + +VisFlag1_ql.hs:14:16: error: [GHC-25115] + • Visibilities of forall-bound variables are not compatible + Expected: forall j. j -> * + Actual: forall k -> k -> * + • In the type ‘V’ + In the expression: f @V MkV + In an equation for ‘bad_tyapp’: bad_tyapp = f @V MkV + +VisFlag1_ql.hs:17:15: error: [GHC-91028] + • Expected kind ‘forall j. j -> *’, but ‘_’ has kind ‘k0’ + Cannot instantiate unification variable ‘k0’ + with a kind involving polytypes: forall j. j -> * + • In the expression: f @_ MkV + In an equation for ‘bad_wild’: bad_wild = f @_ MkV + +VisFlag1_ql.hs:20:15: error: [GHC-25115] + • Visibilities of forall-bound variables are not compatible + Expected: forall j. j -> * + Actual: forall k -> k -> * + • In the first argument of ‘f’, namely ‘MkV’ + In the expression: f MkV + In an equation for ‘bad_infer’: bad_infer = f MkV ===================================== testsuite/tests/typecheck/should_fail/VisFlag2.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + +module VisFlag2 where + +import Data.Kind (Type) + +-- the (Type ->) parameter is to prevent instantiation of invisible variables + +type family Invis :: Type -> forall a. a +type family Vis :: Type -> forall a -> a + +type instance Vis = Invis -- Bad +type instance Invis = Vis -- Bad ===================================== testsuite/tests/typecheck/should_fail/VisFlag2.stderr ===================================== @@ -0,0 +1,14 @@ + +VisFlag2.hs:13:21: error: [GHC-25115] + • Visibilities of forall-bound variables are not compatible + Expected: * -> forall a -> a + Actual: * -> forall a. a + • In the type ‘Invis’ + In the type instance declaration for ‘Vis’ + +VisFlag2.hs:14:23: error: [GHC-25115] + • Visibilities of forall-bound variables are not compatible + Expected: * -> forall a. a + Actual: * -> forall a -> a + • In the type ‘Vis’ + In the type instance declaration for ‘Invis’ ===================================== testsuite/tests/typecheck/should_fail/VisFlag3.hs ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE TypeFamilies #-} + +module VisFlag3 where + +class C (hk :: forall k. k -> k) where + type F (hk :: forall k -> k -> k) ===================================== testsuite/tests/typecheck/should_fail/VisFlag3.stderr ===================================== @@ -0,0 +1,6 @@ + +VisFlag3.hs:6:3: error: [GHC-25115] + • Visibilities of forall-bound variables are not compatible + Expected: forall k. k -> k + Actual: forall k -> k -> k + • In the associated type family declaration for ‘F’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -667,3 +667,7 @@ test('T22570', normal, compile_fail, ['']) test('T22645', normal, compile_fail, ['']) test('T20666', normal, compile_fail, ['']) test('T20666a', normal, compile_fail, ['']) +test('VisFlag1', normal, compile_fail, ['']) +test('VisFlag1_ql', normal, compile_fail, ['']) +test('VisFlag2', normal, compile_fail, ['']) +test('VisFlag3', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/24583c756fe8c58b9afcbf580f13f727cb03394c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/24583c756fe8c58b9afcbf580f13f727cb03394c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 00:12:42 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sun, 05 Feb 2023 19:12:42 -0500 Subject: [Git][ghc/ghc][wip/int-index/visibility-check] Ignore forall visibility in eqType (#22762) Message-ID: <63e045faa975d_1108fec035f0101179f@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/visibility-check at Glasgow Haskell Compiler / GHC Commits: 87058d73 by Vladislav Zavialov at 2023-02-06T03:12:18+03:00 Ignore forall visibility in eqType (#22762) Prior to this change, the equality relation on types took ForAllTyFlag into account, making a distinction between: 1. forall a. blah 2. forall a -> blah Not anymore. This distinction is important in surface Haskell, but it has no meaning in Core where type abstraction and type application are always explicit. At the same time, if we are not careful to track this flag, Core Lint will fail, as reported in #22762: *** Core Lint errors : in result of TcGblEnv axioms *** From-kind of Cast differs from kind of enclosed type From-kind: forall (b :: Bool) -> * Kind of enclosed type: forall {b :: Bool}. * The solution is to compare types for equality modulo visibility (ForAllTyFlag). Updated functions: nonDetCmpType (worker for eqType) eqDeBruijnType tc_eq_type (worker for tcEqType) can_eq_nc In order to retain the distinction between visible and invisible forall in user-written code, we introduce new ad-hoc checks: checkEqForallVis (in checking mode) cteForallKindVisDiff (in inference mode) - - - - - 24 changed files: - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Types/Error/Codes.hs - testsuite/tests/saks/should_fail/T18863a.stderr - + testsuite/tests/typecheck/should_compile/T22762.hs - testsuite/tests/typecheck/should_compile/all.T - + testsuite/tests/typecheck/should_fail/VisFlag1.hs - + testsuite/tests/typecheck/should_fail/VisFlag1.stderr - + testsuite/tests/typecheck/should_fail/VisFlag1_ql.hs - + testsuite/tests/typecheck/should_fail/VisFlag1_ql.stderr - + testsuite/tests/typecheck/should_fail/VisFlag2.hs - + testsuite/tests/typecheck/should_fail/VisFlag2.stderr - + testsuite/tests/typecheck/should_fail/VisFlag3.hs - + testsuite/tests/typecheck/should_fail/VisFlag3.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Core/Map/Type.hs ===================================== @@ -38,7 +38,6 @@ import GHC.Prelude import GHC.Core.Type import GHC.Core.Coercion import GHC.Core.TyCo.Rep -import GHC.Core.TyCo.Compare( eqForAllVis ) import GHC.Data.TrieMap import GHC.Data.FastString @@ -261,11 +260,9 @@ eqDeBruijnType env_t1@(D env1 t1) env_t2@(D env2 t2) = -> liftEquality (tc == tc') `andEq` gos env env' tys tys' (LitTy l, LitTy l') -> liftEquality (l == l') - (ForAllTy (Bndr tv vis) ty, ForAllTy (Bndr tv' vis') ty') - -> -- See Note [ForAllTy and type equality] in - -- GHC.Core.TyCo.Compare for why we use `eqForAllVis` here - liftEquality (vis `eqForAllVis` vis') `andEq` - go (D env (varType tv)) (D env' (varType tv')) `andEq` + (ForAllTy (Bndr tv _) ty, ForAllTy (Bndr tv' _) ty') + -- Ignore ForAllTyFlag. See Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare + -> go (D env (varType tv)) (D env' (varType tv')) `andEq` go (D (extendCME env tv) ty) (D (extendCME env' tv') ty') (CoercionTy {}, CoercionTy {}) -> TEQ ===================================== compiler/GHC/Core/TyCo/Compare.hs ===================================== @@ -16,7 +16,7 @@ module GHC.Core.TyCo.Compare ( tcEqTyConApps, -- * Visiblity comparision - eqForAllVis, cmpForAllVis + eqForAllVis, ) where @@ -171,11 +171,13 @@ tc_eq_type keep_syns vis_only orig_ty1 orig_ty2 go _ (LitTy lit1) (LitTy lit2) = lit1 == lit2 - go env (ForAllTy (Bndr tv1 vis1) ty1) - (ForAllTy (Bndr tv2 vis2) ty2) - = vis1 `eqForAllVis` vis2 - && (vis_only || go env (varType tv1) (varType tv2)) - && go (rnBndr2 env tv1 tv2) ty1 ty2 + go env (ForAllTy (Bndr tv1 _) ty1) + (ForAllTy (Bndr tv2 _) ty2) + -- Ignore ForAllTyFlag. See Note [ForAllTy and type equality] + = kinds_eq && go (rnBndr2 env tv1 tv2) ty1 ty2 + where + kinds_eq | vis_only = True + | otherwise = go env (varType tv1) (varType tv2) -- Make sure we handle all FunTy cases since falling through to the -- AppTy case means that tcSplitAppTyNoView_maybe may see an unzonked @@ -227,7 +229,9 @@ tc_eq_type keep_syns vis_only orig_ty1 orig_ty2 -- | Do these denote the same level of visibility? 'Required' -- arguments are visible, others are not. So this function --- equates 'Specified' and 'Inferred'. Used for printing. +-- equates 'Specified' and 'Inferred'. +-- +-- Used for printing and in tcEqForallVis. eqForAllVis :: ForAllTyFlag -> ForAllTyFlag -> Bool -- See Note [ForAllTy and type equality] -- If you change this, see IMPORTANT NOTE in the above Note @@ -235,28 +239,39 @@ eqForAllVis Required Required = True eqForAllVis (Invisible _) (Invisible _) = True eqForAllVis _ _ = False --- | Do these denote the same level of visibility? 'Required' --- arguments are visible, others are not. So this function --- equates 'Specified' and 'Inferred'. Used for printing. -cmpForAllVis :: ForAllTyFlag -> ForAllTyFlag -> Ordering --- See Note [ForAllTy and type equality] --- If you change this, see IMPORTANT NOTE in the above Note -cmpForAllVis Required Required = EQ -cmpForAllVis Required (Invisible {}) = LT -cmpForAllVis (Invisible _) Required = GT -cmpForAllVis (Invisible _) (Invisible _) = EQ - - {- Note [ForAllTy and type equality] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When we compare (ForAllTy (Bndr tv1 vis1) ty1) and (ForAllTy (Bndr tv2 vis2) ty2) -what should we do about `vis1` vs `vis2`. - -First, we always compare with `eqForAllVis` and `cmpForAllVis`. -But what decision do we make? - -Should GHC type-check the following program (adapted from #15740)? +what should we do about `vis1` vs `vis2`? + +One option is to take those flags into account and check (vis1==vis2). +But in Core, the visibilities of forall-bound variables have no meaning, +as type abstraction and type application are always explicit. +Going to great lengths to carry them around is counterproductive, +but not going far enough may lead to Core Lint errors (#22762). + +The other option (the one we take) is to ignore those flags. +Neither the name of a forall-bound variable nor its visibility flag +affect GHC's notion of type equality. + +That said, the visibilities of foralls do matter +a great deal in user-written programs. For example, if we unify tv := T, where + tv :: forall k. k -> Type + T :: forall k -> k -> Type +then the user cannot substitute `T Maybe` for `tv Maybe` in their program +by hand. They'd have to write `T (Type -> Type) Maybe` instead. +This entails a loss of referential transparency. We solve this issue by +checking the flags *outside* the equality relation. To that end, +there are two ad-hoc checks: + * checkEqForallVis (in checking mode) + * cteForallKindVisDiff (in inference mode) + +These checks use `eqForAllVis` to compare the `ForAllTyFlag`s. +But should we perhaps use (==) instead? +Do we only care about visibility (Required vs Invisible) +or do we also care about specificity (Specified vs Inferred)? +For example, should GHC type-check the following program (adapted from #15740)? {-# LANGUAGE PolyKinds, ... #-} data D a @@ -280,12 +295,7 @@ programs like the one above. Whether a kind variable binder ends up being specified or inferred can be somewhat subtle, however, especially for kinds that aren't explicitly written out in the source code (like in D above). -For now, we decide - - the specified/inferred status of an invisible type variable binder - does not affect GHC's notion of equality. - -That is, we have the following: +For now, we decide to ignore specificity. That is, we have the following: -------------------------------------------------- | Type 1 | Type 2 | Equal? | @@ -303,11 +313,9 @@ That is, we have the following: | | forall k -> <...> | Yes | -------------------------------------------------- -IMPORTANT NOTE: if we want to change this decision, ForAllCo will need to carry -visiblity (by taking a ForAllTyBinder rathre than a TyCoVar), so that -coercionLKind/RKind build forall types that match (are equal to) the desired -ones. Otherwise we get an infinite loop in the solver via canEqCanLHSHetero. -Examples: T16946, T15079. +One unfortunate consequence of this setup is that it can be exploited +to observe the order of inferred quantification (#22648). However, fixing this +would be a breaking change, so we choose not to (at least for now). Historical Note [Typechecker equality vs definitional equality] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -335,7 +343,7 @@ is more finer-grained than definitional equality in two places: Constraint, but typechecker treats them as distinct types. * Unlike definitional equality, which does not care about the ForAllTyFlag of a - ForAllTy, typechecker equality treats Required type variable binders as + ForAllTy, typechecker equality treated Required type variable binders as distinct from Invisible type variable binders. See Note [ForAllTy and type equality] @@ -513,9 +521,9 @@ nonDetCmpTypeX env orig_t1 orig_t2 = go env (TyVarTy tv1) (TyVarTy tv2) = liftOrdering $ rnOccL env tv1 `nonDetCmpVar` rnOccR env tv2 - go env (ForAllTy (Bndr tv1 vis1) t1) (ForAllTy (Bndr tv2 vis2) t2) - = liftOrdering (vis1 `cmpForAllVis` vis2) - `thenCmpTy` go env (varType tv1) (varType tv2) + go env (ForAllTy (Bndr tv1 _) t1) (ForAllTy (Bndr tv2 _) t2) + -- Ignore ForAllTyFlag. See Note [ForAllTy and type equality] + = go env (varType tv1) (varType tv2) `thenCmpTy` go (rnBndr2 env tv1 tv2) t1 t2 -- See Note [Equality on AppTys] ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -1673,6 +1673,16 @@ mkTyVarEqErr' ctxt item (tv1, co1) ty2 -- to be helpful since this is just an unimplemented feature. return (main_msg, []) + -- The kinds of 'tv1' and 'ty2' contain forall-bound variables that + -- differ in visibility (ForAllTyFlag). + | check_eq_result `cterHasProblem` cteForallKindVisDiff + = let reason = ForallKindVisDiff tv1 ty2 + main_msg = + CannotUnifyVariable + { mismatchMsg = headline_msg + , cannotUnifyReason = reason } + in return (main_msg, []) + | isSkolemTyVar tv1 -- ty2 won't be a meta-tyvar; we would have -- swapped in Solver.Canonical.canEqTyVarHomo || isTyVarTyVar tv1 && not (isTyVarTy ty2) ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1226,6 +1226,12 @@ instance Diagnostic TcRnMessage where TcRnSectionWithoutParentheses expr -> mkSimpleDecorated $ hang (text "A section must be enclosed in parentheses") 2 (text "thus:" <+> (parens (ppr expr))) + TcRnIncompatibleForallVisibility act exp -> + mkSimpleDecorated $ + hang (text "Visibilities of forall-bound variables are not compatible") 2 $ + vcat + [ text "Expected:" <+> ppr exp + , text " Actual:" <+> ppr act ] TcRnCapturedTermName tv_name shadowed_term_names -> mkSimpleDecorated $ @@ -1734,6 +1740,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnDuplicateMinimalSig{} -> ErrorWithoutFlag + TcRnIncompatibleForallVisibility{} + -> ErrorWithoutFlag diagnosticHints = \case TcRnUnknownMessage m @@ -2173,6 +2181,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnDuplicateMinimalSig{} -> noHints + TcRnIncompatibleForallVisibility{} + -> noHints diagnosticCode = constructorCode @@ -2970,6 +2980,10 @@ pprCannotUnifyVariableReason ctxt (DifferentTyVars tv_info) pprCannotUnifyVariableReason ctxt (RepresentationalEq tv_info mb_coercible_msg) = pprTyVarInfo ctxt tv_info $$ maybe empty pprCoercibleMsg mb_coercible_msg +pprCannotUnifyVariableReason _ (ForallKindVisDiff tv1 ty2) + = hang (text "Visibilities of forall-bound variables in kinds differ") 2 $ + vcat [ ppr tv1 <+> text "::" <+> ppr (tyVarKind tv1) + , ppr ty2 <+> text "::" <+> ppr (typeKind ty2) ] pprMismatchMsg :: SolverReportErrCtxt -> MismatchMsg -> SDoc pprMismatchMsg ctxt ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -2924,6 +2924,22 @@ data TcRnMessage where -} TcRnDuplicateMinimalSig :: LSig GhcPs -> LSig GhcPs -> [LSig GhcPs] -> TcRnMessage + {-| TcRnIncompatibleForallVisibility is an error that occurs when + the expected and actual types contain forall-bound variables + that have incompatible visibilities. + + Example: + type family Invis :: Type -> forall a. a + type family Vis :: Type -> forall a -> a + type instance Vis = Invis -- Bad instance + + Test cases: T18863a VisFlag1 VisFlag1_ql VisFlag2 VisFlag3 + -} + TcRnIncompatibleForallVisibility + :: TcType + -> TcType + -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. @@ -3787,6 +3803,20 @@ data CannotUnifyVariableReason -- type Int, or with a 'TyVarTv'. | DifferentTyVars TyVarInfo | RepresentationalEq TyVarInfo (Maybe CoercibleMsg) + + -- | Can't unify a kind-polymorphic type variable with a type + -- due to differences in visibility between forall-bound variables in their kinds. + -- + -- Example: + -- data V k (a :: k) = MkV + -- f :: forall {k} {a :: k} (hk :: forall j. j -> Type). hk a -> () + -- bad_infer = f MkV + -- -- we want to unify hk := V + -- -- but hk :: forall j. j -> Type + -- -- V :: forall k -> k -> Type + -- + -- Test cases: VisFlag1 + | ForallKindVisDiff TyVar Type deriving Generic -- | Report a mismatch error without any extra ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -361,7 +361,8 @@ tcApp rn_expr exp_res_ty -- app_res_rho and exp_res_ty are both rho-types, -- so with simple subsumption we can just unify them -- No need to zonk; the unifier does that - do { co <- unifyExpectedType rn_expr app_res_rho exp_res_ty + do { checkEqForallVis app_res_rho exp_res_ty + ; co <- unifyExpectedType rn_expr app_res_rho exp_res_ty ; return (mkWpCastN co) } else -- Deep subsumption @@ -371,6 +372,7 @@ tcApp rn_expr exp_res_ty -- Zonk app_res_rho first, because QL may have instantiated some -- delta variables to polytypes, and tcSubType doesn't expect that do { app_res_rho <- zonkQuickLook do_ql app_res_rho + ; checkEqForallVis app_res_rho exp_res_ty ; tcSubTypeDS rn_expr app_res_rho exp_res_ty } -- Typecheck the value arguments @@ -1050,9 +1052,9 @@ qlUnify delta ty1 ty2 -- Passes the occurs check = do { let ty2_kind = typeKind ty2 kappa_kind = tyVarKind kappa + ; checkEqForallVis ty2_kind (Check kappa_kind) ; co <- unifyKind (Just (TypeThing ty2)) ty2_kind kappa_kind -- unifyKind: see Note [Actual unification in qlUnify] - ; traceTc "qlUnify:update" $ vcat [ hang (ppr kappa <+> dcolon <+> ppr kappa_kind) 2 (text ":=" <+> ppr ty2 <+> dcolon <+> ppr ty2_kind) ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -1931,6 +1931,7 @@ checkExpectedKind hs_ty ty act_kind exp_kind ; let res_ty = ty `mkAppTys` new_args + ; checkEqForallVis act_kind' (mkCheckExpType exp_kind) ; if act_kind' `tcEqType` exp_kind then return res_ty -- This is very common else do { co_k <- uType KindLevel origin act_kind' exp_kind @@ -2552,6 +2553,7 @@ kcCheckDeclHeader_sig sig_kind name flav ; case ctx_k of AnyKind -> return () -- No signature _ -> do { res_ki <- newExpectedKind ctx_k + ; checkEqForallVis res_ki (mkCheckExpType sig_res_kind') ; discardResult (unifyKind Nothing sig_res_kind' res_ki) } -- Add more binders for data/newtype, so the result kind has no arrows @@ -3284,6 +3286,7 @@ bindExplicitTKBndrsX skol_mode@(SM { sm_parent = check_parent, sm_kind = ctxt_ki | check_parent , Just (ATyVar _ tv) <- lookupNameEnv lcl_env name = do { kind <- tc_lhs_kind_sig tc_ki_mode (TyVarBndrKindCtxt name) lhs_kind + ; checkEqForallVis kind (Check (tyVarKind tv)) ; discardResult $ unifyKind (Just . NameThing $ name) kind (tyVarKind tv) -- This unify rejects: ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -1095,9 +1095,9 @@ can_eq_nc' rewritten _rdr_env _envs ev eq_rel ty1 _ ty2 _ = canTyConApp rewritten ev eq_rel tc1 tys1 tc2 tys2 can_eq_nc' _rewritten _rdr_env _envs ev eq_rel - s1@(ForAllTy (Bndr _ vis1) _) _ - s2@(ForAllTy (Bndr _ vis2) _) _ - | vis1 `eqForAllVis` vis2 -- Note [ForAllTy and type equality] + s1@(ForAllTy _ _) _ + s2@(ForAllTy _ _) _ + -- Ignore ForAllTyFlag. See Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare = can_eq_nc_forall ev eq_rel s1 s2 -- See Note [Canonicalising type applications] about why we require rewritten types ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -34,6 +34,7 @@ module GHC.Tc.Types.Constraint ( CheckTyEqResult, CheckTyEqProblem, cteProblem, cterClearOccursCheck, cteOK, cteImpredicative, cteTypeFamily, cteInsolubleOccurs, cteSolubleOccurs, cterSetOccursCheckSoluble, + cteForallKindVisDiff, cterHasNoProblem, cterHasProblem, cterHasOnlyProblem, cterRemoveProblem, cterHasOccursCheck, cterFromKind, @@ -452,12 +453,13 @@ cterHasNoProblem _ = False -- | An individual problem that might be logged in a 'CheckTyEqResult' newtype CheckTyEqProblem = CTEP Word8 -cteImpredicative, cteTypeFamily, cteInsolubleOccurs, cteSolubleOccurs :: CheckTyEqProblem +cteImpredicative, cteTypeFamily, cteInsolubleOccurs, cteSolubleOccurs, cteForallKindVisDiff :: CheckTyEqProblem cteImpredicative = CTEP (bit 0) -- forall or (=>) encountered cteTypeFamily = CTEP (bit 1) -- type family encountered cteInsolubleOccurs = CTEP (bit 2) -- occurs-check cteSolubleOccurs = CTEP (bit 3) -- occurs-check under a type function or in a coercion -- must be one bit to the left of cteInsolubleOccurs +cteForallKindVisDiff = CTEP (bit 4) -- differing visibility of forall-bound variables in the kind -- See also Note [Insoluble occurs check] in GHC.Tc.Errors cteProblem :: CheckTyEqProblem -> CheckTyEqResult @@ -521,7 +523,8 @@ instance Outputable CheckTyEqResult where all_bits = [ (cteImpredicative, "cteImpredicative") , (cteTypeFamily, "cteTypeFamily") , (cteInsolubleOccurs, "cteInsolubleOccurs") - , (cteSolubleOccurs, "cteSolubleOccurs") ] + , (cteSolubleOccurs, "cteSolubleOccurs") + , (cteForallKindVisDiff, "cteForallKindVisDiff") ] set_bits = [ text str | (bitmask, str) <- all_bits , cter `cterHasProblem` bitmask ] ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -66,6 +66,10 @@ module GHC.Tc.Utils.TcMType ( checkingExpType_maybe, checkingExpType, inferResultToType, ensureMonoType, promoteTcType, + -------------------------------- + -- Visibility flag check + tcEqForallVis, checkEqForallVis, + -------------------------------- -- Zonking and tidying zonkTidyTcType, zonkTidyTcTypes, zonkTidyOrigin, zonkTidyOrigins, @@ -604,6 +608,108 @@ tc_infer mb_frr tc_check ; res_ty <- readExpType res_ty ; return (result, res_ty) } +{- ********************************************************************* +* * + Visibility flag check +* * +********************************************************************* -} + +-- Check if two presumably equal types actually differ in the visibility +-- of their foralls. Example (from #18863): +-- +-- type IDa :: forall i -> i -> Type +-- data IDa :: forall i. i -> Type +-- +-- Report TcRnIncompatibleForallVisibility if the visibilities differ, +-- as in the example above. +-- +-- See Note [Presumably equal types] +checkEqForallVis :: TcType -> ExpType -> TcM () +checkEqForallVis _ (Infer _) = return () +checkEqForallVis ty1 (Check ty2) = + unless (tcEqForallVis ty1 ty2) $ + addErr $ TcRnIncompatibleForallVisibility ty1 ty2 + +-- Structurally match two presumably equal types, checking that all pairs of +-- foralls have equal visibilities. +-- +-- See Note [Presumably equal types] +tcEqForallVis :: Type -> Type -> Bool +tcEqForallVis = matchUpForAllTyFlags eqForAllVis + +-- Structurally match two presumably equal types, checking that all pairs of +-- forall visibility flags (ForAllTyFlag) satisfy a predicate. +-- +-- For example, given the types +-- ty1 = forall a1. Bool -> forall b1. ... +-- ty2 = forall a2. Bool -> forall b2 -> ... +-- We have +-- matchUpForAllTyFlags f ty1 ty2 = +-- f Specified Specified && -- from (a1, a2) +-- f Specified Required -- from (b1, b2) +-- +-- Metavariables are of no interest to us: they stand for monotypes, so there +-- are no forall flags to be found. We do not look through metavariables. +-- +-- See Note [Presumably equal types] +matchUpForAllTyFlags + :: (ForAllTyFlag -> ForAllTyFlag -> Bool) + -> TcType -- actual + -> TcType -- expected + -> Bool +matchUpForAllTyFlags zip_flags actual expected = + go actual expected True + where + go :: TcType -> TcType -> Bool -> Bool + -- See Note [Comparing nullary type synonyms] in GHC.Core.Type + go (TyConApp tc1 []) (TyConApp tc2 []) cont | tc1 == tc2 = cont + + go t1 t2 cont | Just t1' <- coreView t1 = go t1' t2 cont + go t1 t2 cont | Just t2' <- coreView t2 = go t1 t2' cont + + go (LitTy lit1) (LitTy lit2) cont + | lit1 /= lit2 = True -- ex falso shortcut + | otherwise = cont + + go (ForAllTy (Bndr tv1 vis1) ty1) (ForAllTy (Bndr tv2 vis2) ty2) cont + = go (varType tv1) (varType tv2) $ + go ty1 ty2 $ + zip_flags vis1 vis2 && cont + + go (FunTy _ w1 arg1 res1) (FunTy _ w2 arg2 res2) cont = + go arg1 arg2 $ go res1 res2 $ go w1 w2 $ cont + go (AppTy s1 t1) (AppTy s2 t2) cont = + go s1 s2 $ go t1 t2 $ cont + go (TyConApp tc1 ts1) (TyConApp tc2 ts2) cont + | tc1 /= tc2 = True -- ex falso shortcut + | otherwise = gos ts1 ts2 cont + + go (CastTy t1 _) t2 cont = go t1 t2 cont + go t1 (CastTy t2 _) cont = go t1 t2 cont + go _ _ cont = cont + + gos (t1:ts1) (t2:ts2) cont = gos ts1 ts2 $ go t1 t2 cont + gos [] [] cont = cont + gos _ _ _ = True -- ex falso shortcut + +{- Note [Presumably equal types] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In matchUpForAllTyFlags (and by extension tcEqForallVis, checkEqForallVis) +we want to be checking the logical implication + (ty1 = ty2) ⊃ (forall flags satisfy the predicate) +If the assumption (ty1 = ty2) does not hold, the correct thing to do is to +return True (ex falso sequitur quodlibet). + +However, implementing these semantics precisely would make this function +more complicated and expensive. For instance, we'd have to maintain a RnEnv2 +to check type variables for equality. + +As a pragmatic compromise, we say that the result of matchUpForAllTyFlags is +not well-defined if (ty1 /= ty2). This should not matter in practice, as +those functions are only ever used in conjunction with an actual equality check. +The worst case scenario is that we report a less helpful error message. +-} + {- ********************************************************************* * * Promoting types ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -2636,12 +2636,14 @@ checkTypeEq :: CanEqLHS -> TcType -> CheckTyEqResult -- case-analysis on 'lhs') -- * checkEqCanLHSFinish, which does not know the form of 'lhs' checkTypeEq lhs ty - = go ty + = go ty S.<> + go_kind (canEqLHSKind lhs) (typeKind ty) where impredicative = cteProblem cteImpredicative type_family = cteProblem cteTypeFamily insoluble_occurs = cteProblem cteInsolubleOccurs soluble_occurs = cteProblem cteSolubleOccurs + forall_kind_vis_diff = cteProblem cteForallKindVisDiff -- The GHCi runtime debugger does its type-matching with -- unification variables that can unify with a polytype @@ -2721,3 +2723,8 @@ checkTypeEq lhs ty | ghci_tv = \ _tc -> cteOK | otherwise = \ tc -> (if isTauTyCon tc then cteOK else impredicative) S.<> (if isFamFreeTyCon tc then cteOK else type_family) + + go_kind :: TcKind -> TcKind -> CheckTyEqResult + go_kind k1 k2 + | tcEqForallVis k1 k2 = cteOK + | otherwise = forall_kind_vis_diff ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -321,6 +321,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "SkolemEscape" = 46956 GhcDiagnosticCode "DifferentTyVars" = 25897 GhcDiagnosticCode "RepresentationalEq" = 10283 + GhcDiagnosticCode "ForallKindVisDiff" = 11809 -- Typechecker/renamer diagnostic codes GhcDiagnosticCode "TcRnRedundantConstraints" = 30606 @@ -512,6 +513,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnUnexpectedDefaultSig" = 40700 GhcDiagnosticCode "TcRnBindInBootFile" = 11247 GhcDiagnosticCode "TcRnDuplicateMinimalSig" = 85346 + GhcDiagnosticCode "TcRnIncompatibleForallVisibility" = 25115 -- IllegalNewtypeReason GhcDiagnosticCode "DoesNotHaveSingleField" = 23517 ===================================== testsuite/tests/saks/should_fail/T18863a.stderr ===================================== @@ -1,5 +1,6 @@ -T18863a.hs:9:1: error: [GHC-83865] - • Couldn't match expected kind: forall i. i -> * - with actual kind: forall i -> i -> * +T18863a.hs:9:1: error: [GHC-25115] + • Visibilities of forall-bound variables are not compatible + Expected: forall i -> i -> * + Actual: forall i. i -> * • In the data type declaration for ‘IDa’ ===================================== testsuite/tests/typecheck/should_compile/T22762.hs ===================================== @@ -0,0 +1,20 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +module T22762 where + +import Data.Kind + +type Const :: a -> b -> a +type family Const x y where + Const x _ = x + +type F :: (forall (b :: Bool) -> Const Type b) -> Type +data F f + +type G :: forall (b :: Bool) -> Type +data G b + +type H :: Type +type family H where + H = F G ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -857,3 +857,4 @@ test('T22647', normal, compile, ['']) test('T19577', normal, compile, ['']) test('T22383', normal, compile, ['']) test('T21501', normal, compile, ['']) +test('T22762', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/VisFlag1.hs ===================================== @@ -0,0 +1,18 @@ +module VisFlag1 where + +import Data.Kind (Type) + +type V :: forall k -> k -> Type +data V k (a :: k) = MkV + +f :: forall {k} {a :: k} (hk :: forall j. j -> Type). hk a -> () +f _ = () + +bad_tyapp :: () +bad_tyapp = f @V MkV + +bad_wild :: () +bad_wild = f @_ MkV + +bad_infer :: () +bad_infer = f MkV ===================================== testsuite/tests/typecheck/should_fail/VisFlag1.stderr ===================================== @@ -0,0 +1,26 @@ + +VisFlag1.hs:12:16: error: [GHC-25115] + • Visibilities of forall-bound variables are not compatible + Expected: forall j. j -> * + Actual: forall k -> k -> * + • In the type ‘V’ + In the expression: f @V MkV + In an equation for ‘bad_tyapp’: bad_tyapp = f @V MkV + +VisFlag1.hs:15:15: error: [GHC-91028] + • Expected kind ‘forall j. j -> *’, but ‘_’ has kind ‘k0’ + Cannot instantiate unification variable ‘k0’ + with a kind involving polytypes: forall j. j -> * + • In the expression: f @_ MkV + In an equation for ‘bad_wild’: bad_wild = f @_ MkV + +VisFlag1.hs:18:15: error: [GHC-11809] + • Couldn't match type ‘hk0’ with ‘V’ + Expected: hk0 a0 + Actual: V k1 a0 + Visibilities of forall-bound variables in kinds differ + hk0 :: forall j. j -> * + V :: forall k -> k -> * + • In the first argument of ‘f’, namely ‘MkV’ + In the expression: f MkV + In an equation for ‘bad_infer’: bad_infer = f MkV ===================================== testsuite/tests/typecheck/should_fail/VisFlag1_ql.hs ===================================== @@ -0,0 +1,20 @@ +{-# LANGUAGE ImpredicativeTypes #-} + +module VisFlag1_ql where + +import Data.Kind (Type) + +type V :: forall k -> k -> Type +data V k (a :: k) = MkV + +f :: forall {k} {a :: k} (hk :: forall j. j -> Type). hk a -> () +f _ = () + +bad_tyapp :: () +bad_tyapp = f @V MkV + +bad_wild :: () +bad_wild = f @_ MkV + +bad_infer :: () +bad_infer = f MkV ===================================== testsuite/tests/typecheck/should_fail/VisFlag1_ql.stderr ===================================== @@ -0,0 +1,23 @@ + +VisFlag1_ql.hs:14:16: error: [GHC-25115] + • Visibilities of forall-bound variables are not compatible + Expected: forall j. j -> * + Actual: forall k -> k -> * + • In the type ‘V’ + In the expression: f @V MkV + In an equation for ‘bad_tyapp’: bad_tyapp = f @V MkV + +VisFlag1_ql.hs:17:15: error: [GHC-91028] + • Expected kind ‘forall j. j -> *’, but ‘_’ has kind ‘k0’ + Cannot instantiate unification variable ‘k0’ + with a kind involving polytypes: forall j. j -> * + • In the expression: f @_ MkV + In an equation for ‘bad_wild’: bad_wild = f @_ MkV + +VisFlag1_ql.hs:20:15: error: [GHC-25115] + • Visibilities of forall-bound variables are not compatible + Expected: forall j. j -> * + Actual: forall k -> k -> * + • In the first argument of ‘f’, namely ‘MkV’ + In the expression: f MkV + In an equation for ‘bad_infer’: bad_infer = f MkV ===================================== testsuite/tests/typecheck/should_fail/VisFlag2.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + +module VisFlag2 where + +import Data.Kind (Type) + +-- the (Type ->) parameter is to prevent instantiation of invisible variables + +type family Invis :: Type -> forall a. a +type family Vis :: Type -> forall a -> a + +type instance Vis = Invis -- Bad +type instance Invis = Vis -- Bad ===================================== testsuite/tests/typecheck/should_fail/VisFlag2.stderr ===================================== @@ -0,0 +1,14 @@ + +VisFlag2.hs:13:21: error: [GHC-25115] + • Visibilities of forall-bound variables are not compatible + Expected: * -> forall a -> a + Actual: * -> forall a. a + • In the type ‘Invis’ + In the type instance declaration for ‘Vis’ + +VisFlag2.hs:14:23: error: [GHC-25115] + • Visibilities of forall-bound variables are not compatible + Expected: * -> forall a. a + Actual: * -> forall a -> a + • In the type ‘Vis’ + In the type instance declaration for ‘Invis’ ===================================== testsuite/tests/typecheck/should_fail/VisFlag3.hs ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE TypeFamilies #-} + +module VisFlag3 where + +class C (hk :: forall k. k -> k) where + type F (hk :: forall k -> k -> k) ===================================== testsuite/tests/typecheck/should_fail/VisFlag3.stderr ===================================== @@ -0,0 +1,6 @@ + +VisFlag3.hs:6:3: error: [GHC-25115] + • Visibilities of forall-bound variables are not compatible + Expected: forall k. k -> k + Actual: forall k -> k -> k + • In the associated type family declaration for ‘F’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -667,3 +667,7 @@ test('T22570', normal, compile_fail, ['']) test('T22645', normal, compile_fail, ['']) test('T20666', normal, compile_fail, ['']) test('T20666a', normal, compile_fail, ['']) +test('VisFlag1', normal, compile_fail, ['']) +test('VisFlag1_ql', normal, compile_fail, ['']) +test('VisFlag2', normal, compile_fail, ['']) +test('VisFlag3', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/87058d732cde1f178fd3fd5e1d8af378aef3d300 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/87058d732cde1f178fd3fd5e1d8af378aef3d300 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 04:00:14 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Sun, 05 Feb 2023 23:00:14 -0500 Subject: [Git][ghc/ghc][wip/js-fileStat] 17 commits: docs: 9.6 release notes for wasm backend Message-ID: <63e07b4e3b876_1108fec035f0102198@gitlab.mail> Josh Meredith pushed to branch wip/js-fileStat at Glasgow Haskell Compiler / GHC Commits: 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - 56637075 by Josh Meredith at 2023-02-06T03:59:42+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/CmmToLlvm/Mangler.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/List/SetOps.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Env.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Stg/Lift/Monad.hs - compiler/GHC/SysTools/Terminal.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Types/CostCentre.hs - compiler/ghc.cabal.in - configure.ac The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7ea76a64bc90fe95b4ab830685338163dc0c3a91...56637075d8f5ef0facf16d0ca09ed06e2a291548 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7ea76a64bc90fe95b4ab830685338163dc0c3a91...56637075d8f5ef0facf16d0ca09ed06e2a291548 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 07:48:15 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Mon, 06 Feb 2023 02:48:15 -0500 Subject: [Git][ghc/ghc][wip/js-fileStat] Update JavaScript fileStat to match Emscripten layout Message-ID: <63e0b0bf5cbf6_1108fedca32a01034873@gitlab.mail> Josh Meredith pushed to branch wip/js-fileStat at Glasgow Haskell Compiler / GHC Commits: b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 4 changed files: - libraries/base/jsbits/base.js - testsuite/tests/callarity/unittest/all.T - testsuite/tests/corelint/all.T - testsuite/tests/ghc-api/all.T Changes: ===================================== libraries/base/jsbits/base.js ===================================== @@ -452,48 +452,91 @@ function h$base_c_s_isfifo(mode) { } #ifndef GHCJS_BROWSER +// The `fileStat` is filled according to the layout of Emscripten's `stat` +// struct - defined in stat.h. We must use this layout due to this header +// file being used to retrieve the offsets for hsc files that peek into +// memory locations of structs directly. For more information see: +// https://gitlab.haskell.org/ghc/ghc/-/issues/22573 function h$base_fillStat(fs, b, off) { if(off%4) throw "h$base_fillStat: not aligned"; var o = off>>2; - b.i3[o+0] = fs.mode; + + b.i3[o+0] = fs.dev; + b.i3[o+1] = 0; // __st_dev_padding; + b.i3[o+2] = 0; // __st_ino_truncated; + b.i3[o+3] = fs.mode; + h$long_from_number(fs.nlink, (h,l) => { + b.i3[o+4] = h; + b.i3[o+5] = l; + }); + b.i3[o+6] = fs.uid; + b.i3[o+7] = fs.gid; + b.i3[o+8] = fs.rdev; + b.i3[o+9] = 0; // __st_rdev_padding; h$long_from_number(fs.size, (h,l) => { - b.i3[o+1] = h; - b.i3[o+2] = l; + b.i3[o+10] = h; + b.i3[o+11] = l; + }); + b.i3[o+12] = fs.blksize; + b.i3[o+13] = fs.blocks; + atimeS = Math.floor(fs.atimeMs/1000); + h$long_from_number(atimeS, (h,l) => { + b.i3[o+14] = h; + b.i3[o+15] = l; + }); + atimeNs = (fs.atimeMs/1000 - atimeS) * 1000000000; + h$long_from_number(atimeNs, (h,l) => { + b.i3[o+16] = h; + b.i3[o+17] = l; + }); + mtimeS = Math.floor(fs.mtimeMs/1000); + h$long_from_number(mtimeS, (h,l) => { + b.i3[o+18] = h; + b.i3[o+19] = l; + }); + mtimeNs = (fs.mtimeMs/1000 - mtimeS) * 1000000000; + h$long_from_number(mtimeNs, (h,l) => { + b.i3[o+20] = h; + b.i3[o+21] = l; + }); + ctimeS = Math.floor(fs.ctimeMs/1000); + h$long_from_number(ctimeS, (h,l) => { + b.i3[o+22] = h; + b.i3[o+23] = l; + }); + ctimeNs = (fs.ctimeMs/1000 - ctimeS) * 1000000000; + h$long_from_number(ctimeNs, (h,l) => { + b.i3[o+24] = h; + b.i3[o+25] = l; }); - - b.i3[o+3] = 0; // fixme - b.i3[o+4] = 0; // fixme - b.i3[o+5] = fs.dev; h$long_from_number(fs.ino, (h,l) => { - b.i3[o+6] = h; - b.i3[o+7] = l; + b.i3[o+26] = h; + b.i3[o+27] = l; }); - b.i3[o+8] = fs.uid; - b.i3[o+9] = fs.gid; } #endif // [mode,size1,size2,mtime1,mtime2,dev,ino1,ino2,uid,gid] all 32 bit -/** @const */ var h$base_sizeof_stat = 40; +/** @const */ var h$base_sizeof_stat = 112; function h$base_st_mtime(stat, stat_off) { - RETURN_UBX_TUP2(stat.i3[(stat_off>>2)+3], stat.i3[(stat_off>>2)+4]); + RETURN_UBX_TUP2(stat.i3[(stat_off>>2)+18], stat.i3[(stat_off>>2)+19]); } function h$base_st_size(stat, stat_off) { - RETURN_UBX_TUP2(stat.i3[(stat_off>>2)+1], stat.i3[(stat_off>>2)+2]); + RETURN_UBX_TUP2(stat.i3[(stat_off>>2)+10], stat.i3[(stat_off>>2)+11]); } function h$base_st_mode(stat, stat_off) { - return stat.i3[stat_off>>2]; + return stat.i3[(stat_off>>2)+3]; } function h$base_st_dev(stat, stat_off) { - return stat.i3[(stat_off>>2)+5]; + return stat.i3[(stat_off>>2)+0]; } function h$base_st_ino(stat, stat_off) { - RETURN_UBX_TUP2(stat.i3[(stat_off>>2)+6], stat.i3[(stat_off>>2)+7]); + RETURN_UBX_TUP2(stat.i3[(stat_off>>2)+26], stat.i3[(stat_off>>2)+27]); } /** @const */ var h$base_echo = 1; ===================================== testsuite/tests/callarity/unittest/all.T ===================================== @@ -5,4 +5,4 @@ setTestOpts(f) setTestOpts(extra_hc_opts('-package ghc')) setTestOpts(extra_run_opts('"' + config.libdir + '"')) -test('CallArity1', js_broken(22362), compile_and_run, ['']) +test('CallArity1', normal, compile_and_run, ['']) ===================================== testsuite/tests/corelint/all.T ===================================== @@ -7,6 +7,6 @@ test('T21152', normal, compile, ['-g3']) setTestOpts(extra_hc_opts('-package ghc')) setTestOpts(extra_run_opts('"' + config.libdir + '"')) -test('LintEtaExpand', js_broken(22362), compile_and_run, ['']) +test('LintEtaExpand', normal, compile_and_run, ['']) ## These tests use the GHC API. ## Test cases which don't use the GHC API should be added nearer the top. ===================================== testsuite/tests/ghc-api/all.T ===================================== @@ -4,14 +4,14 @@ test('T8639_api', req_rts_linker, makefile_test, ['T8639_api']) test('T8628', req_rts_linker, makefile_test, ['T8628']) -test('T9595', [extra_run_opts('"' + config.libdir + '"'), js_broken(22362)], +test('T9595', [extra_run_opts('"' + config.libdir + '"')], compile_and_run, ['-package ghc']) test('T10508_api', [ extra_run_opts('"' + config.libdir + '"'), req_rts_linker ], compile_and_run, ['-package ghc']) -test('T10942', [extra_run_opts('"' + config.libdir + '"'), js_broken(22362)], +test('T10942', [extra_run_opts('"' + config.libdir + '"')], compile_and_run, ['-package ghc']) test('T9015', extra_run_opts('"' + config.libdir + '"'), @@ -26,7 +26,7 @@ test('T18181', compile_and_run, ['-package ghc']) test('T18522-dbg-ppr', - [extra_run_opts('"' + config.libdir + '"'), js_broken(22362)], + [extra_run_opts('"' + config.libdir + '"'), fragile(22362)], compile_and_run, ['-package ghc']) test('T19156', [ extra_run_opts('"' + config.libdir + '"') View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b18fbf52f98d0128c52b3a90ddca727a6d5d4d45 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b18fbf52f98d0128c52b3a90ddca727a6d5d4d45 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 08:32:10 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Mon, 06 Feb 2023 03:32:10 -0500 Subject: [Git][ghc/ghc][wip/T22740] 17 commits: docs: 9.6 release notes for wasm backend Message-ID: <63e0bb0aba44a_1108fe592243f0105236a@gitlab.mail> Sylvain Henry pushed to branch wip/T22740 at Glasgow Haskell Compiler / GHC Commits: 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - 35b13f9c by Sylvain Henry at 2023-02-06T09:30:17+01:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/CmmToLlvm/Mangler.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/List/SetOps.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Env.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Stg/Lift/Monad.hs - compiler/GHC/SysTools/Terminal.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2cef38b1b3030b9bf51c8519fcc9c43b597f1b3a...35b13f9c2a954f94e17f622cd237dfc486e87e7d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2cef38b1b3030b9bf51c8519fcc9c43b597f1b3a...35b13f9c2a954f94e17f622cd237dfc486e87e7d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 08:32:28 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 06 Feb 2023 03:32:28 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Fix colors in emacs terminal Message-ID: <63e0bb1c6cce4_1108fe57bbbfdc10530e3@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - 291ddd54 by Luite Stegeman at 2023-02-06T03:32:16-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - e37532fb by Jan Hrček at 2023-02-06T03:32:20-05:00 Remove extraneous word in Roles user guide - - - - - 5 changed files: - compiler/GHC/SysTools/Terminal.hs - docs/users_guide/exts/roles.rst - libraries/base/changelog.md - rts/js/gc.js - utils/ghc-pkg/Main.hs Changes: ===================================== compiler/GHC/SysTools/Terminal.hs ===================================== @@ -5,6 +5,7 @@ module GHC.SysTools.Terminal (stderrSupportsAnsiColors) where import GHC.Prelude #if !defined(mingw32_HOST_OS) +import System.Environment (lookupEnv) import System.IO (hIsTerminalDevice, stderr) #else import GHC.IO (catchException) @@ -36,8 +37,10 @@ stderrSupportsAnsiColors = unsafePerformIO stderrSupportsAnsiColors' stderrSupportsAnsiColors' :: IO Bool stderrSupportsAnsiColors' = do #if !defined(mingw32_HOST_OS) - -- Coloured text is a part of ANSI standard, no reason to query terminfo - hIsTerminalDevice stderr + -- Equivalent of https://hackage.haskell.org/package/ansi-terminal/docs/System-Console-ANSI.html#v:hSupportsANSI + isTerminal <- hIsTerminalDevice stderr + term <- lookupEnv "TERM" + pure $ isTerminal && term /= Just "dumb" #else h <- Win32.getStdHandle Win32.sTD_ERROR_HANDLE `catchException` \ (_ :: IOError) -> ===================================== docs/users_guide/exts/roles.rst ===================================== @@ -103,7 +103,7 @@ hand, has its parameter at role nominal, because ``Complex Age`` and Role inference -------------- -What role should a given type parameter should have? GHC performs role +What role should a given type parameter have? GHC performs role inference to determine the correct role for every parameter. It starts with a few base facts: ``(->)`` has two representational parameters; ``(~)`` has two nominal parameters; all type families' parameters are ===================================== libraries/base/changelog.md ===================================== @@ -1,5 +1,10 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) +## 4.19.0.0 *TBA* + * 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. + ## 4.18.0.0 *TBA* * `Foreign.C.ConstPtr.ConstrPtr` was added to encode `const`-qualified pointer types in foreign declarations when using `CApiFFI` extension. ([CLC proposal #117](https://github.com/haskell/core-libraries-committee/issues/117)) @@ -63,9 +68,6 @@ * Add `Data.Typeable.heqT`, a kind-heterogeneous version of `Data.Typeable.eqT` ([CLC proposal #99](https://github.com/haskell/core-libraries-committee/issues/99)) - * 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. ## 4.17.0.0 *August 2022* ===================================== rts/js/gc.js ===================================== @@ -493,7 +493,8 @@ function h$follow(obj, sp) { } } for(i=0;i [InstalledPackageInfo] -> IO () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/35b15d67e762520818b5983a2fabd92477bb776e...e37532fb5f792f3a8a11686c1556ad07d12f62ec -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/35b15d67e762520818b5983a2fabd92477bb776e...e37532fb5f792f3a8a11686c1556ad07d12f62ec You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 08:33:21 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Mon, 06 Feb 2023 03:33:21 -0500 Subject: [Git][ghc/ghc][wip/T22740] JS: replace "js" architecture with "javascript" Message-ID: <63e0bb513406d_1108fe193a7398105838e@gitlab.mail> Sylvain Henry pushed to branch wip/T22740 at Glasgow Haskell Compiler / GHC Commits: 93257480 by Sylvain Henry at 2023-02-06T09:36:57+01:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - config.sub - configure.ac - hadrian/bindist/config.mk.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - libraries/base/Control/Concurrent.hs - libraries/base/GHC/Conc/IO.hs - libraries/base/GHC/Conc/Windows.hs - libraries/base/GHC/Event.hs - libraries/base/GHC/Event/Thread.hs - libraries/base/GHC/Event/TimerManager.hs - libraries/base/GHC/IO/Encoding.hs - libraries/base/GHC/IO/Encoding/CodePage/API.hs - libraries/base/GHC/IO/FD.hs - libraries/base/GHC/JS/Prim.hs - libraries/base/GHC/JS/Prim/Internal/Build.hs - libraries/base/GHC/Stack/CCS.hsc - libraries/base/GHC/TopHandler.hs - libraries/base/GHC/Windows.hs - libraries/base/System/CPUTime.hsc - libraries/base/System/Environment.hs - libraries/base/System/Environment/ExecutablePath.hsc - libraries/base/System/Posix/Internals.hs - libraries/base/System/Timeout.hs - libraries/base/base.cabal - libraries/ghc-boot/GHC/Platform/ArchOS.hs - libraries/ghci/GHCi/CreateBCO.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9325748067966f6e08adbb182f2c04d9e86f7ad8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9325748067966f6e08adbb182f2c04d9e86f7ad8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 09:34:35 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Mon, 06 Feb 2023 04:34:35 -0500 Subject: [Git][ghc/ghc][wip/js-rts-fixmes] Apply 1 suggestion(s) to 1 file(s) Message-ID: <63e0c9aba7e34_1108fe5264810827bd@gitlab.mail> Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC Commits: acbeb433 by Sylvain Henry at 2023-02-06T09:34:33+00:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 1 changed file: - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -175,8 +175,9 @@ closureConstructors s = BlockStat mkDataFill n = funName ||= toJExpr fun where funName = TxtI $ dataName n - extra_args = ValExpr . JHash . listToUniqMap . zip dataFieldNames $ map (toJExpr . TxtI) dataFieldNames - fun = JFunc (map TxtI dataFieldNames) (checkD <> returnS extra_args) + ds = take n dataFieldNames + extra_args = ValExpr . JHash . listToUniqMap . zip ds $ map (toJExpr . TxtI) ds + fun = JFunc (map TxtI ds) (checkD <> returnS extra_args) -- | JS Payload to perform stack manipulation in the RTS stackManip :: JStat View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/acbeb4331ed19fb5406b381a8a9c2d87fd290381 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/acbeb4331ed19fb5406b381a8a9c2d87fd290381 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 11:52:56 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 06 Feb 2023 06:52:56 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Update JavaScript fileStat to match Emscripten layout Message-ID: <63e0ea188e704_1108fe526481170527@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - a11a1db1 by Sylvain Henry at 2023-02-06T06:52:35-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 7944deea by Luite Stegeman at 2023-02-06T06:52:37-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 6c2a5ec2 by Jan Hrček at 2023-02-06T06:52:40-05:00 Remove extraneous word in Roles user guide - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - config.sub - configure.ac - docs/users_guide/exts/roles.rst - hadrian/bindist/config.mk.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - libraries/base/Control/Concurrent.hs - libraries/base/GHC/Conc/IO.hs - libraries/base/GHC/Conc/Windows.hs - libraries/base/GHC/Event.hs - libraries/base/GHC/Event/Thread.hs - libraries/base/GHC/Event/TimerManager.hs - libraries/base/GHC/IO/Encoding.hs - libraries/base/GHC/IO/Encoding/CodePage/API.hs - libraries/base/GHC/IO/FD.hs - libraries/base/GHC/JS/Prim.hs - libraries/base/GHC/JS/Prim/Internal/Build.hs - libraries/base/GHC/Stack/CCS.hsc - libraries/base/GHC/TopHandler.hs - libraries/base/GHC/Windows.hs - libraries/base/System/CPUTime.hsc - libraries/base/System/Environment.hs - libraries/base/System/Environment/ExecutablePath.hsc - libraries/base/System/Posix/Internals.hs - libraries/base/System/Timeout.hs - libraries/base/base.cabal - libraries/base/jsbits/base.js The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e37532fb5f792f3a8a11686c1556ad07d12f62ec...6c2a5ec25742b5175304f7c5652be8a04d3efab6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e37532fb5f792f3a8a11686c1556ad07d12f62ec...6c2a5ec25742b5175304f7c5652be8a04d3efab6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 12:34:49 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 06 Feb 2023 07:34:49 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/fix-comments-tycon Message-ID: <63e0f3e98d3aa_1108fe193a73981199624@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/fix-comments-tycon at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/fix-comments-tycon You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 12:38:21 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 06 Feb 2023 07:38:21 -0500 Subject: [Git][ghc/ghc][wip/romes/fix-comments-tycon] Update kinds in comments in GHC.Core.TyCon Message-ID: <63e0f4bdd988a_1108fedca32a012016d2@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/fix-comments-tycon at Glasgow Haskell Compiler / GHC Commits: 9a978b00 by romes at 2023-02-06T12:38:10+00:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 1 changed file: - compiler/GHC/Core/TyCon.hs Changes: ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -194,7 +194,7 @@ Note [Type synonym families] * Type synonym families, also known as "type functions", map directly onto the type functions in FC: - type family F a :: * + type family F a :: Type type instance F Int = Bool ..etc... @@ -210,11 +210,11 @@ Note [Type synonym families] type instance F (F Int) = ... -- BAD! * Translation of type family decl: - type family F a :: * + type family F a :: Type translates to a FamilyTyCon 'F', whose FamTyConFlav is OpenSynFamilyTyCon - type family G a :: * where + type family G a :: Type where G Int = Bool G Bool = Char G a = () @@ -229,7 +229,7 @@ Note [Data type families] See also Note [Wrappers for data instance tycons] in GHC.Types.Id.Make * Data type families are declared thus - data family T a :: * + data family T a :: Type data instance T Int = T1 | T2 Bool Here T is the "family TyCon". @@ -321,7 +321,7 @@ See also Note [Wrappers for data instance tycons] in GHC.Types.Id.Make should not think of a data family T as a *type function* at all, not even an injective one! We can't allow even injective type functions on the LHS of a type function: - type family injective G a :: * + type family injective G a :: Type type instance F (G Int) = Bool is no good, even if G is injective, because consider type instance G Int = Bool @@ -572,21 +572,21 @@ Since they are user-callable we must get their type-argument visibility information right; and that info is in the TyConBinders. Here is an example: - data App a b = MkApp (a b) -- App :: forall {k}. (k->*) -> k -> * + data App a b = MkApp (a b) -- App :: forall {k}. (k->Type) -> k -> Type The TyCon has - tyConTyBinders = [ Named (Bndr (k :: *) Inferred), Anon (k->*), Anon k ] + tyConTyBinders = [ Named (Bndr (k :: Type) Inferred), Anon (k->Type), Anon k ] The TyConBinders for App line up with App's kind, given above. But the DataCon MkApp has the type - MkApp :: forall {k} (a:k->*) (b:k). a b -> App k a b + MkApp :: forall {k} (a:k->Type) (b:k). a b -> App k a b That is, its ForAllTyBinders should be - dataConUnivTyVarBinders = [ Bndr (k:*) Inferred - , Bndr (a:k->*) Specified + dataConUnivTyVarBinders = [ Bndr (k:Type) Inferred + , Bndr (a:k->Type) Specified , Bndr (b:k) Specified ] So tyConTyVarBinders converts TyCon's TyConBinders into TyVarBinders: @@ -620,8 +620,8 @@ They fit together like so: type App a (b :: k) = a b - tyConBinders = [ Bndr (k::*) (NamedTCB Inferred) - , Bndr (a:k->*) AnonTCB + tyConBinders = [ Bndr (k::Type) (NamedTCB Inferred) + , Bndr (a:k->Type) AnonTCB , Bndr (b:k) AnonTCB ] Note that there are three binders here, including the @@ -636,13 +636,13 @@ They fit together like so: that TyVar may scope over some other part of the TyCon's definition. Eg type T a = a -> a we have - tyConBinders = [ Bndr (a:*) AnonTCB ] + tyConBinders = [ Bndr (a:Type) AnonTCB ] synTcRhs = a -> a So the 'a' scopes over the synTcRhs * From the tyConBinders and tyConResKind we can get the tyConKind E.g for our App example: - App :: forall k. (k->*) -> k -> * + App :: forall k. (k->Type) -> k -> Type We get a 'forall' in the kind for each NamedTCB, and an arrow for each AnonTCB @@ -725,15 +725,15 @@ instance Binary TyConBndrVis where -- things such as: -- -- 1) Data declarations: @data Foo = ...@ creates the @Foo@ type constructor of --- kind @*@ +-- kind @Type@ -- -- 2) Type synonyms: @type Foo = ...@ creates the @Foo@ type constructor -- -- 3) Newtypes: @newtype Foo a = MkFoo ...@ creates the @Foo@ type constructor --- of kind @* -> *@ +-- of kind @Type -> Type@ -- -- 4) Class declarations: @class Foo where@ creates the @Foo@ type constructor --- of kind @*@ +-- of kind @Constraint@ -- -- This data type also encodes a number of primitive, built in type constructors -- such as those for function and tuple types. @@ -1252,16 +1252,16 @@ data FamTyConFlav -- -- These are introduced by either a top level declaration: -- - -- > data family T a :: * + -- > data family T a :: Type -- -- Or an associated data type declaration, within a class declaration: -- -- > class C a b where - -- > data T b :: * + -- > data T b :: Type DataFamilyTyCon TyConRepName - -- | An open type synonym family e.g. @type family F x y :: * -> *@ + -- | An open type synonym family e.g. @type family F x y :: Type -> Type@ | OpenSynFamilyTyCon -- | A closed type synonym family e.g. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9a978b00466908a71e9008d569164a7bcaa0fb17 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9a978b00466908a71e9008d569164a7bcaa0fb17 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 13:48:53 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 06 Feb 2023 08:48:53 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/mp-revert-exit-joins Message-ID: <63e1054568d83_1108fe5264812281c4@gitlab.mail> Matthew Pickering pushed new branch wip/mp-revert-exit-joins at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/mp-revert-exit-joins You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 14:43:18 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 06 Feb 2023 09:43:18 -0500 Subject: [Git][ghc/ghc][master] Update JavaScript fileStat to match Emscripten layout Message-ID: <63e11206aadad_1108fe5264812521f2@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 4 changed files: - libraries/base/jsbits/base.js - testsuite/tests/callarity/unittest/all.T - testsuite/tests/corelint/all.T - testsuite/tests/ghc-api/all.T Changes: ===================================== libraries/base/jsbits/base.js ===================================== @@ -452,48 +452,91 @@ function h$base_c_s_isfifo(mode) { } #ifndef GHCJS_BROWSER +// The `fileStat` is filled according to the layout of Emscripten's `stat` +// struct - defined in stat.h. We must use this layout due to this header +// file being used to retrieve the offsets for hsc files that peek into +// memory locations of structs directly. For more information see: +// https://gitlab.haskell.org/ghc/ghc/-/issues/22573 function h$base_fillStat(fs, b, off) { if(off%4) throw "h$base_fillStat: not aligned"; var o = off>>2; - b.i3[o+0] = fs.mode; + + b.i3[o+0] = fs.dev; + b.i3[o+1] = 0; // __st_dev_padding; + b.i3[o+2] = 0; // __st_ino_truncated; + b.i3[o+3] = fs.mode; + h$long_from_number(fs.nlink, (h,l) => { + b.i3[o+4] = h; + b.i3[o+5] = l; + }); + b.i3[o+6] = fs.uid; + b.i3[o+7] = fs.gid; + b.i3[o+8] = fs.rdev; + b.i3[o+9] = 0; // __st_rdev_padding; h$long_from_number(fs.size, (h,l) => { - b.i3[o+1] = h; - b.i3[o+2] = l; + b.i3[o+10] = h; + b.i3[o+11] = l; + }); + b.i3[o+12] = fs.blksize; + b.i3[o+13] = fs.blocks; + atimeS = Math.floor(fs.atimeMs/1000); + h$long_from_number(atimeS, (h,l) => { + b.i3[o+14] = h; + b.i3[o+15] = l; + }); + atimeNs = (fs.atimeMs/1000 - atimeS) * 1000000000; + h$long_from_number(atimeNs, (h,l) => { + b.i3[o+16] = h; + b.i3[o+17] = l; + }); + mtimeS = Math.floor(fs.mtimeMs/1000); + h$long_from_number(mtimeS, (h,l) => { + b.i3[o+18] = h; + b.i3[o+19] = l; + }); + mtimeNs = (fs.mtimeMs/1000 - mtimeS) * 1000000000; + h$long_from_number(mtimeNs, (h,l) => { + b.i3[o+20] = h; + b.i3[o+21] = l; + }); + ctimeS = Math.floor(fs.ctimeMs/1000); + h$long_from_number(ctimeS, (h,l) => { + b.i3[o+22] = h; + b.i3[o+23] = l; + }); + ctimeNs = (fs.ctimeMs/1000 - ctimeS) * 1000000000; + h$long_from_number(ctimeNs, (h,l) => { + b.i3[o+24] = h; + b.i3[o+25] = l; }); - - b.i3[o+3] = 0; // fixme - b.i3[o+4] = 0; // fixme - b.i3[o+5] = fs.dev; h$long_from_number(fs.ino, (h,l) => { - b.i3[o+6] = h; - b.i3[o+7] = l; + b.i3[o+26] = h; + b.i3[o+27] = l; }); - b.i3[o+8] = fs.uid; - b.i3[o+9] = fs.gid; } #endif // [mode,size1,size2,mtime1,mtime2,dev,ino1,ino2,uid,gid] all 32 bit -/** @const */ var h$base_sizeof_stat = 40; +/** @const */ var h$base_sizeof_stat = 112; function h$base_st_mtime(stat, stat_off) { - RETURN_UBX_TUP2(stat.i3[(stat_off>>2)+3], stat.i3[(stat_off>>2)+4]); + RETURN_UBX_TUP2(stat.i3[(stat_off>>2)+18], stat.i3[(stat_off>>2)+19]); } function h$base_st_size(stat, stat_off) { - RETURN_UBX_TUP2(stat.i3[(stat_off>>2)+1], stat.i3[(stat_off>>2)+2]); + RETURN_UBX_TUP2(stat.i3[(stat_off>>2)+10], stat.i3[(stat_off>>2)+11]); } function h$base_st_mode(stat, stat_off) { - return stat.i3[stat_off>>2]; + return stat.i3[(stat_off>>2)+3]; } function h$base_st_dev(stat, stat_off) { - return stat.i3[(stat_off>>2)+5]; + return stat.i3[(stat_off>>2)+0]; } function h$base_st_ino(stat, stat_off) { - RETURN_UBX_TUP2(stat.i3[(stat_off>>2)+6], stat.i3[(stat_off>>2)+7]); + RETURN_UBX_TUP2(stat.i3[(stat_off>>2)+26], stat.i3[(stat_off>>2)+27]); } /** @const */ var h$base_echo = 1; ===================================== testsuite/tests/callarity/unittest/all.T ===================================== @@ -5,4 +5,4 @@ setTestOpts(f) setTestOpts(extra_hc_opts('-package ghc')) setTestOpts(extra_run_opts('"' + config.libdir + '"')) -test('CallArity1', js_broken(22362), compile_and_run, ['']) +test('CallArity1', normal, compile_and_run, ['']) ===================================== testsuite/tests/corelint/all.T ===================================== @@ -7,6 +7,6 @@ test('T21152', normal, compile, ['-g3']) setTestOpts(extra_hc_opts('-package ghc')) setTestOpts(extra_run_opts('"' + config.libdir + '"')) -test('LintEtaExpand', js_broken(22362), compile_and_run, ['']) +test('LintEtaExpand', normal, compile_and_run, ['']) ## These tests use the GHC API. ## Test cases which don't use the GHC API should be added nearer the top. ===================================== testsuite/tests/ghc-api/all.T ===================================== @@ -4,14 +4,14 @@ test('T8639_api', req_rts_linker, makefile_test, ['T8639_api']) test('T8628', req_rts_linker, makefile_test, ['T8628']) -test('T9595', [extra_run_opts('"' + config.libdir + '"'), js_broken(22362)], +test('T9595', [extra_run_opts('"' + config.libdir + '"')], compile_and_run, ['-package ghc']) test('T10508_api', [ extra_run_opts('"' + config.libdir + '"'), req_rts_linker ], compile_and_run, ['-package ghc']) -test('T10942', [extra_run_opts('"' + config.libdir + '"'), js_broken(22362)], +test('T10942', [extra_run_opts('"' + config.libdir + '"')], compile_and_run, ['-package ghc']) test('T9015', extra_run_opts('"' + config.libdir + '"'), @@ -26,7 +26,7 @@ test('T18181', compile_and_run, ['-package ghc']) test('T18522-dbg-ppr', - [extra_run_opts('"' + config.libdir + '"'), js_broken(22362)], + [extra_run_opts('"' + config.libdir + '"'), fragile(22362)], compile_and_run, ['-package ghc']) test('T19156', [ extra_run_opts('"' + config.libdir + '"') View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b18fbf52f98d0128c52b3a90ddca727a6d5d4d45 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b18fbf52f98d0128c52b3a90ddca727a6d5d4d45 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 14:43:40 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 06 Feb 2023 09:43:40 -0500 Subject: [Git][ghc/ghc][master] JS: replace "js" architecture with "javascript" Message-ID: <63e1121caef83_1108fe5b3c471c125759c@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - config.sub - configure.ac - hadrian/bindist/config.mk.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - libraries/base/Control/Concurrent.hs - libraries/base/GHC/Conc/IO.hs - libraries/base/GHC/Conc/Windows.hs - libraries/base/GHC/Event.hs - libraries/base/GHC/Event/Thread.hs - libraries/base/GHC/Event/TimerManager.hs - libraries/base/GHC/IO/Encoding.hs - libraries/base/GHC/IO/Encoding/CodePage/API.hs - libraries/base/GHC/IO/FD.hs - libraries/base/GHC/JS/Prim.hs - libraries/base/GHC/JS/Prim/Internal/Build.hs - libraries/base/GHC/Stack/CCS.hsc - libraries/base/GHC/TopHandler.hs - libraries/base/GHC/Windows.hs - libraries/base/System/CPUTime.hsc - libraries/base/System/Environment.hs - libraries/base/System/Environment/ExecutablePath.hsc - libraries/base/System/Posix/Internals.hs - libraries/base/System/Timeout.hs - libraries/base/base.cabal - libraries/ghc-boot/GHC/Platform/ArchOS.hs - libraries/ghci/GHCi/CreateBCO.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6636b670233522f01d002c9b97827d00289dbf5c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6636b670233522f01d002c9b97827d00289dbf5c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 14:44:18 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 06 Feb 2023 09:44:18 -0500 Subject: [Git][ghc/ghc][master] Fix marking async exceptions in the JS backend Message-ID: <63e11242730ed_1108fec035f01262612@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 1 changed file: - rts/js/gc.js Changes: ===================================== rts/js/gc.js ===================================== @@ -493,7 +493,8 @@ function h$follow(obj, sp) { } } for(i=0;i From gitlab at gitlab.haskell.org Mon Feb 6 14:45:10 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 06 Feb 2023 09:45:10 -0500 Subject: [Git][ghc/ghc][master] Remove extraneous word in Roles user guide Message-ID: <63e112768c74c_1108fe5265c1266172@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - 1 changed file: - docs/users_guide/exts/roles.rst Changes: ===================================== docs/users_guide/exts/roles.rst ===================================== @@ -103,7 +103,7 @@ hand, has its parameter at role nominal, because ``Complex Age`` and Role inference -------------- -What role should a given type parameter should have? GHC performs role +What role should a given type parameter have? GHC performs role inference to determine the correct role for every parameter. It starts with a few base facts: ``(->)`` has two representational parameters; ``(~)`` has two nominal parameters; all type families' parameters are View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e09cf82ad111e0a6feed81b726849ceaaf3c805 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e09cf82ad111e0a6feed81b726849ceaaf3c805 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 15:26:32 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 06 Feb 2023 10:26:32 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T21909 Message-ID: <63e11c28acc84_1108fe5ddd5ad81272133@gitlab.mail> Apoorv Ingle pushed new branch wip/T21909 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T21909 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 15:28:47 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 06 Feb 2023 10:28:47 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/revert-bit-twiddles Message-ID: <63e11caf45408_1108fe56cecbdc1272343@gitlab.mail> Matthew Pickering pushed new branch wip/revert-bit-twiddles at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/revert-bit-twiddles You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 15:34:06 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 06 Feb 2023 10:34:06 -0500 Subject: [Git][ghc/ghc][wip/T21909] Give expansion fuel for pending wanted and pending given classes while trying to simplifying them Message-ID: <63e11dee1d7f6_1108fedca32a012743b9@gitlab.mail> Apoorv Ingle pushed to branch wip/T21909 at Glasgow Haskell Compiler / GHC Commits: 1b691032 by Apoorv Ingle at 2023-02-06T09:33:52-06:00 Give expansion fuel for pending wanted and pending given classes while trying to simplifying them Related to #21909 - - - - - 3 changed files: - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs Changes: ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -153,9 +153,9 @@ canClassNC :: CtEvidence -> Class -> [Type] -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence canClassNC ev cls tys | isGiven ev -- See Note [Eagerly expand given superclasses] - = do { sc_cts <- mkStrictSuperClasses ev [] [] cls tys + = do { sc_cts <- mkStrictSuperClasses 3 ev [] [] cls tys ; emitWork sc_cts - ; canClass ev cls tys False } + ; canClass ev cls tys 0 } | CtWanted { ctev_rewriters = rewriters } <- ev , Just ip_name <- isCallStackPred cls tys @@ -181,14 +181,16 @@ canClassNC ev cls tys (ctLocSpan loc) (ctEvExpr new_ev) ; solveCallStack ev ev_cs - ; canClass new_ev cls tys False -- No superclasses + ; canClass new_ev cls tys 0 -- No superclasses } | otherwise - = canClass ev cls tys (has_scs cls) + = canClass ev cls tys fuel where - has_scs cls = not (null (classSCTheta cls)) + fuel | cls_has_scs = 3 + | otherwise = 0 + cls_has_scs = not (null (classSCTheta cls)) loc = ctEvLoc ev orig = ctLocOrigin loc pred = ctEvPred ev @@ -205,7 +207,7 @@ solveCallStack ev ev_cs = do canClass :: CtEvidence -> Class -> [Type] - -> Bool -- True <=> un-explored superclasses + -> ExpansionFuel -- n > 0 <=> un-explored superclasses -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence @@ -497,34 +499,34 @@ makeSuperClasses :: [Ct] -> TcS [Ct] -- least produce the immediate superclasses makeSuperClasses cts = concatMapM go cts where - go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys }) - = mkStrictSuperClasses ev [] [] cls tys + go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys, cc_pend_sc = fuel }) + = mkStrictSuperClasses fuel ev [] [] cls tys go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev })) = assertPpr (isClassPred pred) (ppr pred) $ -- The cts should all have -- class pred heads - mkStrictSuperClasses ev tvs theta cls tys + mkStrictSuperClasses 1 ev tvs theta cls tys where (tvs, theta, cls, tys) = tcSplitDFunTy (ctEvPred ev) go ct = pprPanic "makeSuperClasses" (ppr ct) mkStrictSuperClasses - :: CtEvidence + :: ExpansionFuel -> CtEvidence -> [TyVar] -> ThetaType -- These two args are non-empty only when taking -- superclasses of a /quantified/ constraint -> Class -> [Type] -> TcS [Ct] -- Return constraints for the strict superclasses of -- ev :: forall as. theta => cls tys -mkStrictSuperClasses ev tvs theta cls tys - = mk_strict_superclasses (unitNameSet (className cls)) +mkStrictSuperClasses fuel ev tvs theta cls tys + = mk_strict_superclasses fuel (unitNameSet (className cls)) ev tvs theta cls tys -mk_strict_superclasses :: NameSet -> CtEvidence +mk_strict_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return the immediate superclasses of (cls tys); -- and expand their superclasses, provided none of them are in rec_clss -- nor are repeated -mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) +mk_strict_superclasses fuel rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) tvs theta cls tys = concatMapM do_one_given $ classSCSelIds cls @@ -542,7 +544,7 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) | otherwise = do { given_ev <- newGivenEvVar sc_loc $ mk_given_desc sel_id sc_pred - ; mk_superclasses rec_clss given_ev tvs theta sc_pred } + ; mk_superclasses fuel rec_clss given_ev tvs theta sc_pred } where sc_pred = classMethodInstTy sel_id tys @@ -603,7 +605,7 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) newly_blocked (InstSkol _ head_size) = isJust (this_size `ltPatersonSize` head_size) newly_blocked _ = False -mk_strict_superclasses rec_clss ev tvs theta cls tys +mk_strict_superclasses fuel rec_clss ev tvs theta cls tys | all noFreeVarsOfType tys = return [] -- Wanteds with no variables yield no superclass constraints. -- See Note [Improvement from Ground Wanteds] @@ -618,7 +620,7 @@ mk_strict_superclasses rec_clss ev tvs theta cls tys do_one sc_pred = do { traceTcS "mk_strict_superclasses Wanted" (ppr (mkClassPred cls tys) $$ ppr sc_pred) ; sc_ev <- newWantedNC loc (ctEvRewriters ev) sc_pred - ; mk_superclasses rec_clss sc_ev [] [] sc_pred } + ; mk_superclasses fuel rec_clss sc_ev [] [] sc_pred } {- Note [Improvement from Ground Wanteds] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -633,29 +635,29 @@ dependencies. See Note [Why adding superclasses can help] above. But no variables means no improvement; case closed. -} -mk_superclasses :: NameSet -> CtEvidence +mk_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> PredType -> TcS [Ct] -- Return this constraint, plus its superclasses, if any -mk_superclasses rec_clss ev tvs theta pred +mk_superclasses fuel rec_clss ev tvs theta pred | ClassPred cls tys <- classifyPredType pred - = mk_superclasses_of rec_clss ev tvs theta cls tys + = mk_superclasses_of fuel rec_clss ev tvs theta cls tys | otherwise -- Superclass is not a class predicate = return [mkNonCanonical ev] -mk_superclasses_of :: NameSet -> CtEvidence +mk_superclasses_of :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return this class constraint, -- and expand its superclasses -mk_superclasses_of rec_clss ev tvs theta cls tys +mk_superclasses_of fuel rec_clss ev tvs theta cls tys | loop_found = do { traceTcS "mk_superclasses_of: loop" (ppr cls <+> ppr tys) ; return [this_ct] } -- cc_pend_sc of this_ct = True | otherwise = do { traceTcS "mk_superclasses_of" (vcat [ ppr cls <+> ppr tys , ppr (isCTupleClass cls) , ppr rec_clss ]) - ; sc_cts <- mk_strict_superclasses rec_clss' ev tvs theta cls tys + ; sc_cts <- mk_strict_superclasses fuel rec_clss' ev tvs theta cls tys ; return (this_ct : sc_cts) } -- cc_pend_sc of this_ct = False where @@ -664,9 +666,12 @@ mk_superclasses_of rec_clss ev tvs theta cls tys -- Tuples never contribute to recursion, and can be nested rec_clss' = rec_clss `extendNameSet` cls_nm + this_cc_pend | loop_found = fuel + | otherwise = 0 + this_ct | null tvs, null theta = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys - , cc_pend_sc = loop_found } + , cc_pend_sc = this_cc_pend } -- NB: If there is a loop, we cut off, so we have not -- added the superclasses, hence cc_pend_sc = True | otherwise @@ -827,7 +832,7 @@ canForAllNC :: CtEvidence -> [TyVar] -> TcThetaType -> TcPredType canForAllNC ev tvs theta pred | isGiven ev -- See Note [Eagerly expand given superclasses] , Just (cls, tys) <- cls_pred_tys_maybe - = do { sc_cts <- mkStrictSuperClasses ev tvs theta cls tys + = do { sc_cts <- mkStrictSuperClasses 3 ev tvs theta cls tys ; emitWork sc_cts ; canForAll ev False } ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -534,8 +534,8 @@ get_sc_pending this_lvl ic@(IC { inert_dicts = dicts, inert_insts = insts }) (sc_pend_insts, insts') = mapAccumL get_pending_inst [] insts - get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc = True - -- but flipping the flag + get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc > 0 + -- but decrementing the fuel get_pending dict dicts | Just dict' <- pendingScDict_maybe dict , belongs_to_this_level (ctEvidence dict) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -10,7 +10,7 @@ module GHC.Tc.Types.Constraint ( QCInst(..), pendingScInst_maybe, -- Canonical constraints - Xi, Ct(..), Cts, + Xi, Ct(..), Cts, ExpansionFuel, emptyCts, andCts, andManyCts, pprCts, singleCt, listToCts, ctsElts, consCts, snocCts, extendCtsList, isEmptyCts, @@ -191,6 +191,11 @@ type Xi = TcType type Cts = Bag Ct +-- | Says how many layers of superclasses can we expand. +-- see T21909 +type ExpansionFuel = Int + + data Ct -- Atomic canonical constraints = CDictCan { -- e.g. Num ty @@ -199,10 +204,10 @@ data Ct cc_class :: Class, cc_tyargs :: [Xi], -- cc_tyargs are rewritten w.r.t. inerts, so Xi - cc_pend_sc :: Bool + cc_pend_sc :: ExpansionFuel -- See Note [The superclass story] in GHC.Tc.Solver.Canonical - -- True <=> (a) cc_class has superclasses - -- (b) we have not (yet) added those + -- n > 0 <=> (a) cc_class has superclasses + -- (b) we have not (yet) added those -- superclasses as Givens } @@ -673,8 +678,8 @@ instance Outputable Ct where CEqCan {} -> text "CEqCan" CNonCanonical {} -> text "CNonCanonical" CDictCan { cc_pend_sc = psc } - | psc -> text "CDictCan(psc)" - | otherwise -> text "CDictCan" + | psc > 0 -> text "CDictCan" <> parens (text "psc" <+> ppr psc) + | otherwise -> text "CDictCan" CIrredCan { cc_reason = reason } -> text "CIrredCan" <> ppr reason CQuantCan (QCI { qci_pend_sc = pend_sc }) | pend_sc -> text "CQuantCan(psc)" @@ -893,16 +898,17 @@ isUserTypeError pred = case getUserTypeErrorMsg pred of _ -> False isPendingScDict :: Ct -> Bool -isPendingScDict (CDictCan { cc_pend_sc = psc }) = psc --- Says whether this is a CDictCan with cc_pend_sc is True; +isPendingScDict (CDictCan { cc_pend_sc = psc }) = psc > 0 +-- Says whether this is a CDictCan with cc_pend_sc has positive fuel; -- i.e. pending un-expanded superclasses isPendingScDict _ = False pendingScDict_maybe :: Ct -> Maybe Ct --- Says whether this is a CDictCan with cc_pend_sc is True, +-- Says whether this is a CDictCan with cc_pend_sc has fuel left, -- AND if so flips the flag -pendingScDict_maybe ct@(CDictCan { cc_pend_sc = True }) - = Just (ct { cc_pend_sc = False }) +pendingScDict_maybe ct@(CDictCan { cc_pend_sc = n }) + | n > 0 = Just (ct { cc_pend_sc = n - 1 }) + | otherwise = Nothing pendingScDict_maybe _ = Nothing pendingScInst_maybe :: QCInst -> Maybe QCInst View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1b691032c34c684cd07a31fad879e3628fc4508e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1b691032c34c684cd07a31fad879e3628fc4508e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 16:07:20 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 06 Feb 2023 11:07:20 -0500 Subject: [Git][ghc/ghc][wip/mp-revert-exit-joins] Revert "Use fix-sized equality primops for fixed size boxed types" Message-ID: <63e125b86e1fd_1108fec035f0129325b@gitlab.mail> Matthew Pickering pushed to branch wip/mp-revert-exit-joins at Glasgow Haskell Compiler / GHC Commits: ce3b05d0 by Ben Gamari at 2023-02-06T15:24:49+00:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - 2 changed files: - libraries/base/GHC/Int.hs - libraries/base/GHC/Word.hs Changes: ===================================== libraries/base/GHC/Int.hs ===================================== @@ -69,8 +69,8 @@ instance Eq Int8 where (/=) = neInt8 eqInt8, neInt8 :: Int8 -> Int8 -> Bool -eqInt8 (I8# x) (I8# y) = isTrue# (x `eqInt8#` y) -neInt8 (I8# x) (I8# y) = isTrue# (x `neInt8#` y) +eqInt8 (I8# x) (I8# y) = isTrue# ((int8ToInt# x) ==# (int8ToInt# y)) +neInt8 (I8# x) (I8# y) = isTrue# ((int8ToInt# x) /=# (int8ToInt# y)) {-# INLINE [1] eqInt8 #-} {-# INLINE [1] neInt8 #-} @@ -280,8 +280,8 @@ instance Eq Int16 where (/=) = neInt16 eqInt16, neInt16 :: Int16 -> Int16 -> Bool -eqInt16 (I16# x) (I16# y) = isTrue# (x `eqInt16#` y) -neInt16 (I16# x) (I16# y) = isTrue# (x `neInt16#` y) +eqInt16 (I16# x) (I16# y) = isTrue# ((int16ToInt# x) ==# (int16ToInt# y)) +neInt16 (I16# x) (I16# y) = isTrue# ((int16ToInt# x) /=# (int16ToInt# y)) {-# INLINE [1] eqInt16 #-} {-# INLINE [1] neInt16 #-} @@ -488,8 +488,8 @@ instance Eq Int32 where (/=) = neInt32 eqInt32, neInt32 :: Int32 -> Int32 -> Bool -eqInt32 (I32# x) (I32# y) = isTrue# (x `eqInt32#` y) -neInt32 (I32# x) (I32# y) = isTrue# (x `neInt32#` y) +eqInt32 (I32# x) (I32# y) = isTrue# ((int32ToInt# x) ==# (int32ToInt# y)) +neInt32 (I32# x) (I32# y) = isTrue# ((int32ToInt# x) /=# (int32ToInt# y)) {-# INLINE [1] eqInt32 #-} {-# INLINE [1] neInt32 #-} ===================================== libraries/base/GHC/Word.hs ===================================== @@ -78,8 +78,8 @@ instance Eq Word8 where (/=) = neWord8 eqWord8, neWord8 :: Word8 -> Word8 -> Bool -eqWord8 (W8# x) (W8# y) = isTrue# (x `eqWord8#` y) -neWord8 (W8# x) (W8# y) = isTrue# (x `neWord8#` y) +eqWord8 (W8# x) (W8# y) = isTrue# ((word8ToWord# x) `eqWord#` (word8ToWord# y)) +neWord8 (W8# x) (W8# y) = isTrue# ((word8ToWord# x) `neWord#` (word8ToWord# y)) {-# INLINE [1] eqWord8 #-} {-# INLINE [1] neWord8 #-} @@ -268,8 +268,8 @@ instance Eq Word16 where (/=) = neWord16 eqWord16, neWord16 :: Word16 -> Word16 -> Bool -eqWord16 (W16# x) (W16# y) = isTrue# (x `eqWord16#` y) -neWord16 (W16# x) (W16# y) = isTrue# (x `neWord16#` y) +eqWord16 (W16# x) (W16# y) = isTrue# ((word16ToWord# x) `eqWord#` (word16ToWord# y)) +neWord16 (W16# x) (W16# y) = isTrue# ((word16ToWord# x) `neWord#` (word16ToWord# y)) {-# INLINE [1] eqWord16 #-} {-# INLINE [1] neWord16 #-} @@ -500,8 +500,8 @@ instance Eq Word32 where (/=) = neWord32 eqWord32, neWord32 :: Word32 -> Word32 -> Bool -eqWord32 (W32# x) (W32# y) = isTrue# (x `eqWord32#` y) -neWord32 (W32# x) (W32# y) = isTrue# (x `neWord32#` y) +eqWord32 (W32# x) (W32# y) = isTrue# ((word32ToWord# x) `eqWord#` (word32ToWord# y)) +neWord32 (W32# x) (W32# y) = isTrue# ((word32ToWord# x) `neWord#` (word32ToWord# y)) {-# INLINE [1] eqWord32 #-} {-# INLINE [1] neWord32 #-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ce3b05d03f60fb66f4d0a0f312c790070aee5088 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ce3b05d03f60fb66f4d0a0f312c790070aee5088 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 16:09:19 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 06 Feb 2023 11:09:19 -0500 Subject: [Git][ghc/ghc][wip/T21909] 2 commits: Give expansion fuel for pending wanted and pending given classes while trying to simplifying them Message-ID: <63e1262f17871_1108fe52648129519c@gitlab.mail> Apoorv Ingle pushed to branch wip/T21909 at Glasgow Haskell Compiler / GHC Commits: 99539a4b by Apoorv Ingle at 2023-02-06T10:01:50-06:00 Give expansion fuel for pending wanted and pending given classes while trying to simplifying them Related to #21909 - - - - - 37b27b15 by Apoorv Ingle at 2023-02-06T10:07:41-06:00 test cases for #21909 - - - - - 6 changed files: - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - + testsuite/tests/typecheck/should_compile/T21909.hs - + testsuite/tests/typecheck/should_compile/T21909b.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -153,9 +153,9 @@ canClassNC :: CtEvidence -> Class -> [Type] -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence canClassNC ev cls tys | isGiven ev -- See Note [Eagerly expand given superclasses] - = do { sc_cts <- mkStrictSuperClasses ev [] [] cls tys + = do { sc_cts <- mkStrictSuperClasses defaultExpansionFuel ev [] [] cls tys ; emitWork sc_cts - ; canClass ev cls tys False } + ; canClass ev cls tys noExpansionFuel } | CtWanted { ctev_rewriters = rewriters } <- ev , Just ip_name <- isCallStackPred cls tys @@ -181,14 +181,16 @@ canClassNC ev cls tys (ctLocSpan loc) (ctEvExpr new_ev) ; solveCallStack ev ev_cs - ; canClass new_ev cls tys False -- No superclasses + ; canClass new_ev cls tys noExpansionFuel -- No superclasses } | otherwise - = canClass ev cls tys (has_scs cls) + = canClass ev cls tys fuel where - has_scs cls = not (null (classSCTheta cls)) + fuel | cls_has_scs = defaultExpansionFuel + | otherwise = noExpansionFuel + cls_has_scs = not (null (classSCTheta cls)) loc = ctEvLoc ev orig = ctLocOrigin loc pred = ctEvPred ev @@ -205,7 +207,7 @@ solveCallStack ev ev_cs = do canClass :: CtEvidence -> Class -> [Type] - -> Bool -- True <=> un-explored superclasses + -> ExpansionFuel -- n > 0 <=> un-explored superclasses -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence @@ -497,34 +499,34 @@ makeSuperClasses :: [Ct] -> TcS [Ct] -- least produce the immediate superclasses makeSuperClasses cts = concatMapM go cts where - go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys }) - = mkStrictSuperClasses ev [] [] cls tys + go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys, cc_pend_sc = fuel }) + = mkStrictSuperClasses fuel ev [] [] cls tys go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev })) = assertPpr (isClassPred pred) (ppr pred) $ -- The cts should all have -- class pred heads - mkStrictSuperClasses ev tvs theta cls tys + mkStrictSuperClasses defaultExpansionFuel ev tvs theta cls tys where (tvs, theta, cls, tys) = tcSplitDFunTy (ctEvPred ev) go ct = pprPanic "makeSuperClasses" (ppr ct) mkStrictSuperClasses - :: CtEvidence + :: ExpansionFuel -> CtEvidence -> [TyVar] -> ThetaType -- These two args are non-empty only when taking -- superclasses of a /quantified/ constraint -> Class -> [Type] -> TcS [Ct] -- Return constraints for the strict superclasses of -- ev :: forall as. theta => cls tys -mkStrictSuperClasses ev tvs theta cls tys - = mk_strict_superclasses (unitNameSet (className cls)) +mkStrictSuperClasses fuel ev tvs theta cls tys + = mk_strict_superclasses fuel (unitNameSet (className cls)) ev tvs theta cls tys -mk_strict_superclasses :: NameSet -> CtEvidence +mk_strict_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return the immediate superclasses of (cls tys); -- and expand their superclasses, provided none of them are in rec_clss -- nor are repeated -mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) +mk_strict_superclasses fuel rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) tvs theta cls tys = concatMapM do_one_given $ classSCSelIds cls @@ -542,7 +544,7 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) | otherwise = do { given_ev <- newGivenEvVar sc_loc $ mk_given_desc sel_id sc_pred - ; mk_superclasses rec_clss given_ev tvs theta sc_pred } + ; mk_superclasses fuel rec_clss given_ev tvs theta sc_pred } where sc_pred = classMethodInstTy sel_id tys @@ -603,7 +605,7 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) newly_blocked (InstSkol _ head_size) = isJust (this_size `ltPatersonSize` head_size) newly_blocked _ = False -mk_strict_superclasses rec_clss ev tvs theta cls tys +mk_strict_superclasses fuel rec_clss ev tvs theta cls tys | all noFreeVarsOfType tys = return [] -- Wanteds with no variables yield no superclass constraints. -- See Note [Improvement from Ground Wanteds] @@ -618,7 +620,7 @@ mk_strict_superclasses rec_clss ev tvs theta cls tys do_one sc_pred = do { traceTcS "mk_strict_superclasses Wanted" (ppr (mkClassPred cls tys) $$ ppr sc_pred) ; sc_ev <- newWantedNC loc (ctEvRewriters ev) sc_pred - ; mk_superclasses rec_clss sc_ev [] [] sc_pred } + ; mk_superclasses fuel rec_clss sc_ev [] [] sc_pred } {- Note [Improvement from Ground Wanteds] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -633,29 +635,29 @@ dependencies. See Note [Why adding superclasses can help] above. But no variables means no improvement; case closed. -} -mk_superclasses :: NameSet -> CtEvidence +mk_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> PredType -> TcS [Ct] -- Return this constraint, plus its superclasses, if any -mk_superclasses rec_clss ev tvs theta pred +mk_superclasses fuel rec_clss ev tvs theta pred | ClassPred cls tys <- classifyPredType pred - = mk_superclasses_of rec_clss ev tvs theta cls tys + = mk_superclasses_of fuel rec_clss ev tvs theta cls tys | otherwise -- Superclass is not a class predicate = return [mkNonCanonical ev] -mk_superclasses_of :: NameSet -> CtEvidence +mk_superclasses_of :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return this class constraint, -- and expand its superclasses -mk_superclasses_of rec_clss ev tvs theta cls tys +mk_superclasses_of fuel rec_clss ev tvs theta cls tys | loop_found = do { traceTcS "mk_superclasses_of: loop" (ppr cls <+> ppr tys) ; return [this_ct] } -- cc_pend_sc of this_ct = True | otherwise = do { traceTcS "mk_superclasses_of" (vcat [ ppr cls <+> ppr tys , ppr (isCTupleClass cls) , ppr rec_clss ]) - ; sc_cts <- mk_strict_superclasses rec_clss' ev tvs theta cls tys + ; sc_cts <- mk_strict_superclasses fuel rec_clss' ev tvs theta cls tys ; return (this_ct : sc_cts) } -- cc_pend_sc of this_ct = False where @@ -664,9 +666,12 @@ mk_superclasses_of rec_clss ev tvs theta cls tys -- Tuples never contribute to recursion, and can be nested rec_clss' = rec_clss `extendNameSet` cls_nm + this_cc_pend | loop_found = fuel + | otherwise = 0 + this_ct | null tvs, null theta = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys - , cc_pend_sc = loop_found } + , cc_pend_sc = this_cc_pend } -- NB: If there is a loop, we cut off, so we have not -- added the superclasses, hence cc_pend_sc = True | otherwise @@ -827,7 +832,7 @@ canForAllNC :: CtEvidence -> [TyVar] -> TcThetaType -> TcPredType canForAllNC ev tvs theta pred | isGiven ev -- See Note [Eagerly expand given superclasses] , Just (cls, tys) <- cls_pred_tys_maybe - = do { sc_cts <- mkStrictSuperClasses ev tvs theta cls tys + = do { sc_cts <- mkStrictSuperClasses defaultExpansionFuel ev tvs theta cls tys ; emitWork sc_cts ; canForAll ev False } ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -534,8 +534,8 @@ get_sc_pending this_lvl ic@(IC { inert_dicts = dicts, inert_insts = insts }) (sc_pend_insts, insts') = mapAccumL get_pending_inst [] insts - get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc = True - -- but flipping the flag + get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc > 0 + -- but decrementing the fuel get_pending dict dicts | Just dict' <- pendingScDict_maybe dict , belongs_to_this_level (ctEvidence dict) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -10,7 +10,7 @@ module GHC.Tc.Types.Constraint ( QCInst(..), pendingScInst_maybe, -- Canonical constraints - Xi, Ct(..), Cts, + Xi, Ct(..), Cts, ExpansionFuel, noExpansionFuel, defaultExpansionFuel, emptyCts, andCts, andManyCts, pprCts, singleCt, listToCts, ctsElts, consCts, snocCts, extendCtsList, isEmptyCts, @@ -191,6 +191,15 @@ type Xi = TcType type Cts = Bag Ct +-- | Says how many layers of superclasses can we expand. +-- see T21909 +type ExpansionFuel = Int + +noExpansionFuel, defaultExpansionFuel :: Int +noExpansionFuel = 0 +defaultExpansionFuel = 3 + + data Ct -- Atomic canonical constraints = CDictCan { -- e.g. Num ty @@ -199,10 +208,10 @@ data Ct cc_class :: Class, cc_tyargs :: [Xi], -- cc_tyargs are rewritten w.r.t. inerts, so Xi - cc_pend_sc :: Bool + cc_pend_sc :: ExpansionFuel -- See Note [The superclass story] in GHC.Tc.Solver.Canonical - -- True <=> (a) cc_class has superclasses - -- (b) we have not (yet) added those + -- n > 0 <=> (a) cc_class has superclasses + -- (b) we have not (yet) added those -- superclasses as Givens } @@ -673,8 +682,8 @@ instance Outputable Ct where CEqCan {} -> text "CEqCan" CNonCanonical {} -> text "CNonCanonical" CDictCan { cc_pend_sc = psc } - | psc -> text "CDictCan(psc)" - | otherwise -> text "CDictCan" + | psc > 0 -> text "CDictCan" <> parens (text "psc" <+> ppr psc) + | otherwise -> text "CDictCan" CIrredCan { cc_reason = reason } -> text "CIrredCan" <> ppr reason CQuantCan (QCI { qci_pend_sc = pend_sc }) | pend_sc -> text "CQuantCan(psc)" @@ -893,16 +902,17 @@ isUserTypeError pred = case getUserTypeErrorMsg pred of _ -> False isPendingScDict :: Ct -> Bool -isPendingScDict (CDictCan { cc_pend_sc = psc }) = psc --- Says whether this is a CDictCan with cc_pend_sc is True; +isPendingScDict (CDictCan { cc_pend_sc = psc }) = psc > 0 +-- Says whether this is a CDictCan with cc_pend_sc has positive fuel; -- i.e. pending un-expanded superclasses isPendingScDict _ = False pendingScDict_maybe :: Ct -> Maybe Ct --- Says whether this is a CDictCan with cc_pend_sc is True, +-- Says whether this is a CDictCan with cc_pend_sc has fuel left, -- AND if so flips the flag -pendingScDict_maybe ct@(CDictCan { cc_pend_sc = True }) - = Just (ct { cc_pend_sc = False }) +pendingScDict_maybe ct@(CDictCan { cc_pend_sc = n }) + | n > 0 = Just (ct { cc_pend_sc = n - 1 }) + | otherwise = Nothing pendingScDict_maybe _ = Nothing pendingScInst_maybe :: QCInst -> Maybe QCInst ===================================== testsuite/tests/typecheck/should_compile/T21909.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +module T21909 where + +import Data.Kind + +class (Monad m, MyMonad (Inner m)) => MyMonad m where + type Inner m :: Type -> Type + foo :: m Int + +works :: MyMonad m => m String +works = show <$> ((+ 1) <$> foo) + +fails :: MyMonad m => m String +fails = show <$> fooPlusOne + where + fooPlusOne = (+ 1) <$> foo + +alsoFails :: MyMonad m => m String +alsoFails = + let fooPlusOne = (+ 1) <$> foo + in show <$> fooPlusOne ===================================== testsuite/tests/typecheck/should_compile/T21909b.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableSuperClasses, FunctionalDependencies, MultiParamTypeClasses, GADTs #-} + +module T21909b where + +import Data.Kind + +class C [a] => C a where + foo :: a -> Int + +should_work :: C a => a -> Int +should_work x = foolocal x + where + foolocal a = foo a ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -857,3 +857,5 @@ test('T22647', normal, compile, ['']) test('T19577', normal, compile, ['']) test('T22383', normal, compile, ['']) test('T21501', normal, compile, ['']) +test('T21909', normal, compile, ['']) +test('T21909b', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1b691032c34c684cd07a31fad879e3628fc4508e...37b27b15ff27603f0af1283f3720d09c2f7c5de6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1b691032c34c684cd07a31fad879e3628fc4508e...37b27b15ff27603f0af1283f3720d09c2f7c5de6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 16:14:43 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Mon, 06 Feb 2023 11:14:43 -0500 Subject: [Git][ghc/ghc][wip/js-th] Fix comment for silly haddock Message-ID: <63e127739adc4_1108fe193a73981300166@gitlab.mail> Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC Commits: 653bf305 by Sylvain Henry at 2023-02-06T17:18:42+01:00 Fix comment for silly haddock - - - - - 1 changed file: - compiler/GHC/Runtime/Interpreter/JS.hs Changes: ===================================== compiler/GHC/Runtime/Interpreter/JS.hs ===================================== @@ -7,7 +7,7 @@ -- -- The JS interpreter works as follows: -- --- $topdir/ghc-interp.js is a simple JS script used to bootstrap the external +-- ghc-interp.js is a simple JS script used to bootstrap the external -- interpreter server (iserv) that is written in Haskell. This script waits for -- commands on stdin: -- LOAD foo.js -- load a JS file in the current JS environment View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/653bf305257c886845e80e1b692e105d8cd18ece -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/653bf305257c886845e80e1b692e105d8cd18ece You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 18:50:50 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 06 Feb 2023 13:50:50 -0500 Subject: [Git][ghc/ghc][wip/T21909] reduce fuel for wanted constraints Message-ID: <63e14c0ae15dd_1108fe5265c133544f@gitlab.mail> Apoorv Ingle pushed to branch wip/T21909 at Glasgow Haskell Compiler / GHC Commits: 29a276de by Apoorv Ingle at 2023-02-06T12:50:33-06:00 reduce fuel for wanted constraints - - - - - 1 changed file: - compiler/GHC/Tc/Solver/Canonical.hs Changes: ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -188,7 +188,7 @@ canClassNC ev cls tys = canClass ev cls tys fuel where - fuel | cls_has_scs = defaultExpansionFuel + fuel | cls_has_scs = 1 | otherwise = noExpansionFuel cls_has_scs = not (null (classSCTheta cls)) loc = ctEvLoc ev View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/29a276de4686453852d1699f506528bcb1c421e4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/29a276de4686453852d1699f506528bcb1c421e4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 18:51:33 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 06 Feb 2023 13:51:33 -0500 Subject: [Git][ghc/ghc][wip/T21909] 7 commits: Update JavaScript fileStat to match Emscripten layout Message-ID: <63e14c354f2f6_1108fe617239c0133599e@gitlab.mail> Apoorv Ingle pushed to branch wip/T21909 at Glasgow Haskell Compiler / GHC Commits: b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - 9837dc20 by Apoorv Ingle at 2023-02-06T18:51:31+00:00 Give expansion fuel for pending wanted and pending given classes while trying to simplifying them Related to #21909 - - - - - ea038367 by Apoorv Ingle at 2023-02-06T18:51:31+00:00 test cases for #21909 - - - - - c437f08e by Apoorv Ingle at 2023-02-06T18:51:31+00:00 reduce fuel for wanted constraints - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - config.sub - configure.ac - docs/users_guide/exts/roles.rst - hadrian/bindist/config.mk.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - libraries/base/Control/Concurrent.hs - libraries/base/GHC/Conc/IO.hs - libraries/base/GHC/Conc/Windows.hs - libraries/base/GHC/Event.hs - libraries/base/GHC/Event/Thread.hs - libraries/base/GHC/Event/TimerManager.hs - libraries/base/GHC/IO/Encoding.hs - libraries/base/GHC/IO/Encoding/CodePage/API.hs - libraries/base/GHC/IO/FD.hs - libraries/base/GHC/JS/Prim.hs - libraries/base/GHC/JS/Prim/Internal/Build.hs - libraries/base/GHC/Stack/CCS.hsc - libraries/base/GHC/TopHandler.hs - libraries/base/GHC/Windows.hs - libraries/base/System/CPUTime.hsc - libraries/base/System/Environment.hs - libraries/base/System/Environment/ExecutablePath.hsc - libraries/base/System/Posix/Internals.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/29a276de4686453852d1699f506528bcb1c421e4...c437f08ef9082632553462f2354dd8dd4793296d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/29a276de4686453852d1699f506528bcb1c421e4...c437f08ef9082632553462f2354dd8dd4793296d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 18:54:23 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 06 Feb 2023 13:54:23 -0500 Subject: [Git][ghc/ghc][wip/T21909] 3 commits: Give expansion fuel for pending wanted and pending given classes while trying to simplifying them Message-ID: <63e14cdfabe9c_1108fec035f013362a9@gitlab.mail> Apoorv Ingle pushed to branch wip/T21909 at Glasgow Haskell Compiler / GHC Commits: 002bfe88 by Apoorv Ingle at 2023-02-06T12:52:43-06:00 Give expansion fuel for pending wanted and pending given classes while trying to simplifying them Related to #21909 - - - - - 7a72f0e1 by Apoorv Ingle at 2023-02-06T12:52:43-06:00 test cases for #21909 - - - - - 00741e98 by Apoorv Ingle at 2023-02-06T12:52:43-06:00 reduce fuel for wanted constraints - - - - - 6 changed files: - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - + testsuite/tests/typecheck/should_compile/T21909.hs - + testsuite/tests/typecheck/should_compile/T21909b.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -153,9 +153,9 @@ canClassNC :: CtEvidence -> Class -> [Type] -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence canClassNC ev cls tys | isGiven ev -- See Note [Eagerly expand given superclasses] - = do { sc_cts <- mkStrictSuperClasses ev [] [] cls tys + = do { sc_cts <- mkStrictSuperClasses defaultExpansionFuel ev [] [] cls tys ; emitWork sc_cts - ; canClass ev cls tys False } + ; canClass ev cls tys noExpansionFuel } | CtWanted { ctev_rewriters = rewriters } <- ev , Just ip_name <- isCallStackPred cls tys @@ -181,14 +181,16 @@ canClassNC ev cls tys (ctLocSpan loc) (ctEvExpr new_ev) ; solveCallStack ev ev_cs - ; canClass new_ev cls tys False -- No superclasses + ; canClass new_ev cls tys noExpansionFuel -- No superclasses } | otherwise - = canClass ev cls tys (has_scs cls) + = canClass ev cls tys fuel where - has_scs cls = not (null (classSCTheta cls)) + fuel | cls_has_scs = 1 + | otherwise = noExpansionFuel + cls_has_scs = not (null (classSCTheta cls)) loc = ctEvLoc ev orig = ctLocOrigin loc pred = ctEvPred ev @@ -205,7 +207,7 @@ solveCallStack ev ev_cs = do canClass :: CtEvidence -> Class -> [Type] - -> Bool -- True <=> un-explored superclasses + -> ExpansionFuel -- n > 0 <=> un-explored superclasses -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence @@ -497,34 +499,34 @@ makeSuperClasses :: [Ct] -> TcS [Ct] -- least produce the immediate superclasses makeSuperClasses cts = concatMapM go cts where - go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys }) - = mkStrictSuperClasses ev [] [] cls tys + go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys, cc_pend_sc = fuel }) + = mkStrictSuperClasses fuel ev [] [] cls tys go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev })) = assertPpr (isClassPred pred) (ppr pred) $ -- The cts should all have -- class pred heads - mkStrictSuperClasses ev tvs theta cls tys + mkStrictSuperClasses defaultExpansionFuel ev tvs theta cls tys where (tvs, theta, cls, tys) = tcSplitDFunTy (ctEvPred ev) go ct = pprPanic "makeSuperClasses" (ppr ct) mkStrictSuperClasses - :: CtEvidence + :: ExpansionFuel -> CtEvidence -> [TyVar] -> ThetaType -- These two args are non-empty only when taking -- superclasses of a /quantified/ constraint -> Class -> [Type] -> TcS [Ct] -- Return constraints for the strict superclasses of -- ev :: forall as. theta => cls tys -mkStrictSuperClasses ev tvs theta cls tys - = mk_strict_superclasses (unitNameSet (className cls)) +mkStrictSuperClasses fuel ev tvs theta cls tys + = mk_strict_superclasses fuel (unitNameSet (className cls)) ev tvs theta cls tys -mk_strict_superclasses :: NameSet -> CtEvidence +mk_strict_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return the immediate superclasses of (cls tys); -- and expand their superclasses, provided none of them are in rec_clss -- nor are repeated -mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) +mk_strict_superclasses fuel rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) tvs theta cls tys = concatMapM do_one_given $ classSCSelIds cls @@ -542,7 +544,7 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) | otherwise = do { given_ev <- newGivenEvVar sc_loc $ mk_given_desc sel_id sc_pred - ; mk_superclasses rec_clss given_ev tvs theta sc_pred } + ; mk_superclasses fuel rec_clss given_ev tvs theta sc_pred } where sc_pred = classMethodInstTy sel_id tys @@ -603,7 +605,7 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) newly_blocked (InstSkol _ head_size) = isJust (this_size `ltPatersonSize` head_size) newly_blocked _ = False -mk_strict_superclasses rec_clss ev tvs theta cls tys +mk_strict_superclasses fuel rec_clss ev tvs theta cls tys | all noFreeVarsOfType tys = return [] -- Wanteds with no variables yield no superclass constraints. -- See Note [Improvement from Ground Wanteds] @@ -618,7 +620,7 @@ mk_strict_superclasses rec_clss ev tvs theta cls tys do_one sc_pred = do { traceTcS "mk_strict_superclasses Wanted" (ppr (mkClassPred cls tys) $$ ppr sc_pred) ; sc_ev <- newWantedNC loc (ctEvRewriters ev) sc_pred - ; mk_superclasses rec_clss sc_ev [] [] sc_pred } + ; mk_superclasses fuel rec_clss sc_ev [] [] sc_pred } {- Note [Improvement from Ground Wanteds] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -633,29 +635,29 @@ dependencies. See Note [Why adding superclasses can help] above. But no variables means no improvement; case closed. -} -mk_superclasses :: NameSet -> CtEvidence +mk_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> PredType -> TcS [Ct] -- Return this constraint, plus its superclasses, if any -mk_superclasses rec_clss ev tvs theta pred +mk_superclasses fuel rec_clss ev tvs theta pred | ClassPred cls tys <- classifyPredType pred - = mk_superclasses_of rec_clss ev tvs theta cls tys + = mk_superclasses_of fuel rec_clss ev tvs theta cls tys | otherwise -- Superclass is not a class predicate = return [mkNonCanonical ev] -mk_superclasses_of :: NameSet -> CtEvidence +mk_superclasses_of :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return this class constraint, -- and expand its superclasses -mk_superclasses_of rec_clss ev tvs theta cls tys +mk_superclasses_of fuel rec_clss ev tvs theta cls tys | loop_found = do { traceTcS "mk_superclasses_of: loop" (ppr cls <+> ppr tys) ; return [this_ct] } -- cc_pend_sc of this_ct = True | otherwise = do { traceTcS "mk_superclasses_of" (vcat [ ppr cls <+> ppr tys , ppr (isCTupleClass cls) , ppr rec_clss ]) - ; sc_cts <- mk_strict_superclasses rec_clss' ev tvs theta cls tys + ; sc_cts <- mk_strict_superclasses fuel rec_clss' ev tvs theta cls tys ; return (this_ct : sc_cts) } -- cc_pend_sc of this_ct = False where @@ -664,9 +666,12 @@ mk_superclasses_of rec_clss ev tvs theta cls tys -- Tuples never contribute to recursion, and can be nested rec_clss' = rec_clss `extendNameSet` cls_nm + this_cc_pend | loop_found = fuel + | otherwise = 0 + this_ct | null tvs, null theta = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys - , cc_pend_sc = loop_found } + , cc_pend_sc = this_cc_pend } -- NB: If there is a loop, we cut off, so we have not -- added the superclasses, hence cc_pend_sc = True | otherwise @@ -827,7 +832,7 @@ canForAllNC :: CtEvidence -> [TyVar] -> TcThetaType -> TcPredType canForAllNC ev tvs theta pred | isGiven ev -- See Note [Eagerly expand given superclasses] , Just (cls, tys) <- cls_pred_tys_maybe - = do { sc_cts <- mkStrictSuperClasses ev tvs theta cls tys + = do { sc_cts <- mkStrictSuperClasses defaultExpansionFuel ev tvs theta cls tys ; emitWork sc_cts ; canForAll ev False } ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -534,8 +534,8 @@ get_sc_pending this_lvl ic@(IC { inert_dicts = dicts, inert_insts = insts }) (sc_pend_insts, insts') = mapAccumL get_pending_inst [] insts - get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc = True - -- but flipping the flag + get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc > 0 + -- but decrementing the fuel get_pending dict dicts | Just dict' <- pendingScDict_maybe dict , belongs_to_this_level (ctEvidence dict) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -10,7 +10,7 @@ module GHC.Tc.Types.Constraint ( QCInst(..), pendingScInst_maybe, -- Canonical constraints - Xi, Ct(..), Cts, + Xi, Ct(..), Cts, ExpansionFuel, noExpansionFuel, defaultExpansionFuel, emptyCts, andCts, andManyCts, pprCts, singleCt, listToCts, ctsElts, consCts, snocCts, extendCtsList, isEmptyCts, @@ -191,6 +191,15 @@ type Xi = TcType type Cts = Bag Ct +-- | Says how many layers of superclasses can we expand. +-- see T21909 +type ExpansionFuel = Int + +noExpansionFuel, defaultExpansionFuel :: Int +noExpansionFuel = 0 +defaultExpansionFuel = 3 + + data Ct -- Atomic canonical constraints = CDictCan { -- e.g. Num ty @@ -199,10 +208,10 @@ data Ct cc_class :: Class, cc_tyargs :: [Xi], -- cc_tyargs are rewritten w.r.t. inerts, so Xi - cc_pend_sc :: Bool + cc_pend_sc :: ExpansionFuel -- See Note [The superclass story] in GHC.Tc.Solver.Canonical - -- True <=> (a) cc_class has superclasses - -- (b) we have not (yet) added those + -- n > 0 <=> (a) cc_class has superclasses + -- (b) we have not (yet) added those -- superclasses as Givens } @@ -673,8 +682,8 @@ instance Outputable Ct where CEqCan {} -> text "CEqCan" CNonCanonical {} -> text "CNonCanonical" CDictCan { cc_pend_sc = psc } - | psc -> text "CDictCan(psc)" - | otherwise -> text "CDictCan" + | psc > 0 -> text "CDictCan" <> parens (text "psc" <+> ppr psc) + | otherwise -> text "CDictCan" CIrredCan { cc_reason = reason } -> text "CIrredCan" <> ppr reason CQuantCan (QCI { qci_pend_sc = pend_sc }) | pend_sc -> text "CQuantCan(psc)" @@ -893,16 +902,17 @@ isUserTypeError pred = case getUserTypeErrorMsg pred of _ -> False isPendingScDict :: Ct -> Bool -isPendingScDict (CDictCan { cc_pend_sc = psc }) = psc --- Says whether this is a CDictCan with cc_pend_sc is True; +isPendingScDict (CDictCan { cc_pend_sc = psc }) = psc > 0 +-- Says whether this is a CDictCan with cc_pend_sc has positive fuel; -- i.e. pending un-expanded superclasses isPendingScDict _ = False pendingScDict_maybe :: Ct -> Maybe Ct --- Says whether this is a CDictCan with cc_pend_sc is True, +-- Says whether this is a CDictCan with cc_pend_sc has fuel left, -- AND if so flips the flag -pendingScDict_maybe ct@(CDictCan { cc_pend_sc = True }) - = Just (ct { cc_pend_sc = False }) +pendingScDict_maybe ct@(CDictCan { cc_pend_sc = n }) + | n > 0 = Just (ct { cc_pend_sc = n - 1 }) + | otherwise = Nothing pendingScDict_maybe _ = Nothing pendingScInst_maybe :: QCInst -> Maybe QCInst ===================================== testsuite/tests/typecheck/should_compile/T21909.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +module T21909 where + +import Data.Kind + +class (Monad m, MyMonad (Inner m)) => MyMonad m where + type Inner m :: Type -> Type + foo :: m Int + +works :: MyMonad m => m String +works = show <$> ((+ 1) <$> foo) + +fails :: MyMonad m => m String +fails = show <$> fooPlusOne + where + fooPlusOne = (+ 1) <$> foo + +alsoFails :: MyMonad m => m String +alsoFails = + let fooPlusOne = (+ 1) <$> foo + in show <$> fooPlusOne ===================================== testsuite/tests/typecheck/should_compile/T21909b.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableSuperClasses, FunctionalDependencies, MultiParamTypeClasses, GADTs #-} + +module T21909b where + +import Data.Kind + +class C [a] => C a where + foo :: a -> Int + +should_work :: C a => a -> Int +should_work x = foolocal x + where + foolocal a = foo a ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -857,3 +857,5 @@ test('T22647', normal, compile, ['']) test('T19577', normal, compile, ['']) test('T22383', normal, compile, ['']) test('T21501', normal, compile, ['']) +test('T21909', normal, compile, ['']) +test('T21909b', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c437f08ef9082632553462f2354dd8dd4793296d...00741e98d6993d540d66e9ad26e192b2b071338d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c437f08ef9082632553462f2354dd8dd4793296d...00741e98d6993d540d66e9ad26e192b2b071338d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 18:58:09 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Mon, 06 Feb 2023 13:58:09 -0500 Subject: [Git][ghc/ghc][wip/t21766] Fix byte order of IPE data, fix IPE tests Message-ID: <63e14dc19afe7_1108fe526481336751@gitlab.mail> Finley McIlwaine pushed to branch wip/t21766 at Glasgow Haskell Compiler / GHC Commits: 56b0d3ac by Finley McIlwaine at 2023-02-06T11:55:12-07:00 Fix byte order of IPE data, fix IPE tests Make sure byte order of written IPE buffer entries matches target. Make sure the IPE-related tests properly access the fields of IPE buffer entry nodes with the new IPE layout. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. See ticket #21766. - - - - - 6 changed files: - compiler/GHC/StgToCmm/InfoTableProv.hs - rts/include/rts/IPE.h - testsuite/tests/rts/ipe/ipeEventLog_fromMap.c - testsuite/tests/rts/ipe/ipeMap.c - testsuite/tests/rts/ipe/ipe_lib.c - testsuite/tests/rts/ipe/ipe_lib.h Changes: ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -3,10 +3,14 @@ module GHC.StgToCmm.InfoTableProv (emitIpeBufferListNode) where import Foreign + +#if defined(HAVE_LIBZSTD) import Foreign.C.Types +import qualified Data.ByteString.Internal as BSI +import GHC.IO (unsafePerformIO) +#endif import GHC.Data.FastString (fastStringToShortText) -import GHC.IO (unsafePerformIO) import GHC.Prelude import GHC.Platform import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile) @@ -26,7 +30,6 @@ import Control.Monad.Trans.State.Strict import qualified Data.ByteString as BS import qualified Data.ByteString.Builder as BSB -import qualified Data.ByteString.Internal as BSI import qualified Data.ByteString.Lazy as BSL import qualified Data.Map.Strict as M @@ -90,17 +93,16 @@ emitIpeBufferListNode this_mod ents = do uncompressed_strings = getStringTableStrings strtab strings_bytes :: BS.ByteString - strings_bytes = - if do_compress == 1 then - compress defaultCompressionLevel uncompressed_strings - else - uncompressed_strings + strings_bytes = compress defaultCompressionLevel uncompressed_strings strings :: [CmmStatic] strings = [CmmString strings_bytes] + entries_bytes :: BS.ByteString + entries_bytes = toIpeBufferEntries (platformByteOrder platform) cg_ipes + entries :: [CmmStatic] - entries = toIpeBufferEntries cg_ipes + entries = [CmmString entries_bytes] ipe_buffer_lbl :: CLabel ipe_buffer_lbl = mkIPELabel this_mod @@ -111,7 +113,7 @@ emitIpeBufferListNode this_mod ents = do zeroCLit platform -- 'compressed' field - , int $ do_compress + , int do_compress -- 'count' field , int $ length cg_ipes @@ -123,13 +125,13 @@ emitIpeBufferListNode this_mod ents = do , CmmLabel entries_lbl -- 'entries_size' field - , int (length cg_ipes * 8 * 32) + , int $ BS.length entries_bytes -- 'string_table' field , CmmLabel strings_lbl -- 'string_table_size' field - , int (BS.length strings_bytes) + , int $ BS.length strings_bytes ] -- Emit the list of info table pointers @@ -153,21 +155,17 @@ emitIpeBufferListNode this_mod ents = do (CmmStaticsRaw ipe_buffer_lbl ipe_buffer_node) -- | Emit the fields of an IpeBufferEntry struct for each entry in a given list. --- The fields are converted to a bytestring, compressed, and then emitted as a --- string. If compression is not enabled, the compression step is simply --- @id at . +-- The fields are converted to a bytestring and compressed. If compression is +-- not enabled, the compression step is simply @id at . toIpeBufferEntries :: - [CgInfoProvEnt] -- ^ List of IPE buffer entries - -> [CmmStatic] -toIpeBufferEntries cg_ipes = - [ CmmString - . compress defaultCompressionLevel + ByteOrder -- ^ Byte order to write the data in + -> [CgInfoProvEnt] -- ^ List of IPE buffer entries + -> BS.ByteString +toIpeBufferEntries byte_order cg_ipes = + compress defaultCompressionLevel . BSL.toStrict . BSB.toLazyByteString . mconcat - $ map (mconcat . map (BSB.word32BE) . to_ipe_buf_ent) cg_ipes - ] + $ map (mconcat . map word32Builder . to_ipe_buf_ent) cg_ipes where - int32 n = CmmStaticLit $ CmmInt (fromIntegral n) W32 - to_ipe_buf_ent :: CgInfoProvEnt -> [Word32] to_ipe_buf_ent cg_ipe = [ ipeTableName cg_ipe @@ -180,6 +178,11 @@ toIpeBufferEntries cg_ipes = , 0 -- padding ] + word32Builder :: Word32 -> BSB.Builder + word32Builder = case byte_order of + BigEndian -> BSB.word32BE + LittleEndian -> BSB.word32LE + toCgIPE :: Platform -> SDocContext -> StrTabOffset -> InfoProvEnt -> State StringTable CgInfoProvEnt toCgIPE platform ctx module_name ipe = do table_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (pprCLabel platform (infoTablePtr ipe)) @@ -194,7 +197,7 @@ toCgIPE platform ctx module_name ipe = do coords = renderWithContext ctx (pprUserRealSpan False span) in (file, coords) label <- lookupStringTable $ ST.pack label_str - src_file <- lookupStringTable $ src_loc_file + src_file <- lookupStringTable src_loc_file src_span <- lookupStringTable $ ST.pack src_loc_span return $ CgInfoProvEnt { ipeInfoTablePtr = infoTablePtr ipe , ipeTableName = table_name ===================================== rts/include/rts/IPE.h ===================================== @@ -70,18 +70,18 @@ typedef struct IpeBufferListNode_ { // Everything below is read-only and generated by the codegen // This flag should be treated as a boolean - const StgWord compressed; + StgWord compressed; StgWord count; // When TNTC is enabled, these will point to the entry code // not the info table itself. - const StgInfoTable **tables; + StgInfoTable **tables; - const IpeBufferEntry *entries; + IpeBufferEntry *entries; StgWord entries_size; - const char *string_table; + char *string_table; StgWord string_table_size; } IpeBufferListNode; ===================================== testsuite/tests/rts/ipe/ipeEventLog_fromMap.c ===================================== @@ -19,7 +19,7 @@ int main(int argc, char *argv[]) { registerInfoProvList(list2); // Query an IPE to initialize the underlying hash map. - lookupIPE(list1->entries[0].info); + lookupIPE(list1->tables[0]); // Trace all IPE events. dumpIPEToEventLog(); ===================================== testsuite/tests/rts/ipe/ipeMap.c ===================================== @@ -40,15 +40,23 @@ void shouldFindNothingInAnEmptyIPEMap(Capability *cap) { } HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) { - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + sizeof(IpeBufferEntry)); + // Allocate buffers for IPE buffer list node + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); + node->tables = malloc(sizeof(StgInfoTable *)); + node->entries = malloc(sizeof(IpeBufferEntry)); + StringTable st; init_string_table(&st); HaskellObj fortyTwo = UNTAG_CLOSURE(rts_mkInt(cap, 42)); - node->entries[0] = makeAnyProvEntry(cap, &st, fortyTwo, 42); - node->count = 1; node->next = NULL; + node->compressed = 0; + node->count = 1; + node->tables[0] = get_itbl(fortyTwo); + node->entries[0] = makeAnyProvEntry(cap, &st, 42); + node->entries_size = sizeof(IpeBufferEntry); node->string_table = st.buffer; + node->string_table_size = st.size; registerInfoProvList(node); @@ -72,15 +80,23 @@ HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) { void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap, HaskellObj fortyTwo) { - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + sizeof(IpeBufferEntry)); + // Allocate buffers for IPE buffer list node + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); + node->tables = malloc(sizeof(StgInfoTable *)); + node->entries = malloc(sizeof(IpeBufferEntry)); + StringTable st; init_string_table(&st); HaskellObj twentyThree = UNTAG_CLOSURE(rts_mkInt8(cap, 23)); - node->entries[0] = makeAnyProvEntry(cap, &st, twentyThree, 23); - node->count = 1; node->next = NULL; + node->compressed = 0; + node->count = 1; + node->tables[0] = get_itbl(twentyThree); + node->entries[0] = makeAnyProvEntry(cap, &st, 23); + node->entries_size = sizeof(IpeBufferEntry); node->string_table = st.buffer; + node->string_table_size = st.size; registerInfoProvList(node); @@ -103,17 +119,26 @@ void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap, } void shouldFindTwoFromTheSameList(Capability *cap) { - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + 2 * sizeof(IpeBufferEntry)); + // Allocate buffers for IPE buffer list node + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); + node->tables = malloc(sizeof(StgInfoTable *) * 2); + node->entries = malloc(sizeof(IpeBufferEntry) * 2); + StringTable st; init_string_table(&st); HaskellObj one = UNTAG_CLOSURE(rts_mkInt16(cap, 1)); HaskellObj two = UNTAG_CLOSURE(rts_mkInt32(cap, 2)); - node->entries[0] = makeAnyProvEntry(cap, &st, one, 1); - node->entries[1] = makeAnyProvEntry(cap, &st, two, 2); - node->count = 2; node->next = NULL; + node->compressed = 0; + node->count = 2; + node->tables[0] = get_itbl(one); + node->tables[1] = get_itbl(two); + node->entries[0] = makeAnyProvEntry(cap, &st, 1); + node->entries[1] = makeAnyProvEntry(cap, &st, 2); + node->entries_size = sizeof(IpeBufferEntry) * 2; node->string_table = st.buffer; + node->string_table_size = st.size; registerInfoProvList(node); ===================================== testsuite/tests/rts/ipe/ipe_lib.c ===================================== @@ -25,9 +25,8 @@ uint32_t add_string(StringTable *st, const char *s) { return n; } -IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj closure, int i) { +IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, int i) { IpeBufferEntry provEnt; - provEnt.info = get_itbl(closure); unsigned int tableNameLength = strlen("table_name_") + 3 /* digits */ + 1 /* null character */; char *tableName = malloc(sizeof(char) * tableNameLength); @@ -69,15 +68,27 @@ IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj clo IpeBufferListNode *makeAnyProvEntries(Capability *cap, int start, int end) { const int n = end - start; - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + n * sizeof(IpeBufferEntry)); + + // Allocate buffers for IpeBufferListNode + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); + node->tables = malloc(sizeof(StgInfoTable *) * n); + node->entries = malloc(sizeof(IpeBufferEntry) * n); + StringTable st; init_string_table(&st); + + // Make the entries and fill the buffers for (int i=start; i < end; i++) { HaskellObj closure = rts_mkInt(cap, 42); - node->entries[i] = makeAnyProvEntry(cap, &st, closure, i); + node->tables[i] = get_itbl(closure); + node->entries[i] = makeAnyProvEntry(cap, &st, i); } + + // Set the rest of the fields node->next = NULL; + node->compressed = 0; node->count = n; node->string_table = st.buffer; + return node; } ===================================== testsuite/tests/rts/ipe/ipe_lib.h ===================================== @@ -12,6 +12,6 @@ void init_string_table(StringTable *st); uint32_t add_string(StringTable *st, const char *s); IpeBufferListNode *makeAnyProvEntries(Capability *cap, int start, int end); -IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj closure, int i); +IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, int i); void dumpIPEToEventLog(void); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/56b0d3ac6118f0bfac654ec85c2dcc3dbb27bc4e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/56b0d3ac6118f0bfac654ec85c2dcc3dbb27bc4e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 21:21:21 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 06 Feb 2023 16:21:21 -0500 Subject: [Git][ghc/ghc][wip/T21909] Fixes #21909 Message-ID: <63e16f518da9f_1108fe656dbf40135222f@gitlab.mail> Apoorv Ingle pushed to branch wip/T21909 at Glasgow Haskell Compiler / GHC Commits: 93d04d3e by Apoorv Ingle at 2023-02-06T15:09:33-06:00 Fixes #21909 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag in `CDictCan.cc_pend_sc`. Pending Givens get a fuel of 3 to start of with while Wanted constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints. Added tests T21909, T21909b - - - - - 6 changed files: - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - + testsuite/tests/typecheck/should_compile/T21909.hs - + testsuite/tests/typecheck/should_compile/T21909b.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -153,9 +153,9 @@ canClassNC :: CtEvidence -> Class -> [Type] -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence canClassNC ev cls tys | isGiven ev -- See Note [Eagerly expand given superclasses] - = do { sc_cts <- mkStrictSuperClasses ev [] [] cls tys + = do { sc_cts <- mkStrictSuperClasses defaultExpansionFuel ev [] [] cls tys ; emitWork sc_cts - ; canClass ev cls tys False } + ; canClass ev cls tys noExpansionFuel } | CtWanted { ctev_rewriters = rewriters } <- ev , Just ip_name <- isCallStackPred cls tys @@ -181,14 +181,16 @@ canClassNC ev cls tys (ctLocSpan loc) (ctEvExpr new_ev) ; solveCallStack ev ev_cs - ; canClass new_ev cls tys False -- No superclasses + ; canClass new_ev cls tys noExpansionFuel -- No superclasses } | otherwise - = canClass ev cls tys (has_scs cls) + = canClass ev cls tys fuel where - has_scs cls = not (null (classSCTheta cls)) + fuel | cls_has_scs = 1 + | otherwise = noExpansionFuel + cls_has_scs = not (null (classSCTheta cls)) loc = ctEvLoc ev orig = ctLocOrigin loc pred = ctEvPred ev @@ -205,7 +207,7 @@ solveCallStack ev ev_cs = do canClass :: CtEvidence -> Class -> [Type] - -> Bool -- True <=> un-explored superclasses + -> ExpansionFuel -- n > 0 <=> un-explored superclasses -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence @@ -497,34 +499,34 @@ makeSuperClasses :: [Ct] -> TcS [Ct] -- least produce the immediate superclasses makeSuperClasses cts = concatMapM go cts where - go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys }) - = mkStrictSuperClasses ev [] [] cls tys + go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys, cc_pend_sc = fuel }) + = mkStrictSuperClasses fuel ev [] [] cls tys go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev })) = assertPpr (isClassPred pred) (ppr pred) $ -- The cts should all have -- class pred heads - mkStrictSuperClasses ev tvs theta cls tys + mkStrictSuperClasses defaultExpansionFuel ev tvs theta cls tys where (tvs, theta, cls, tys) = tcSplitDFunTy (ctEvPred ev) go ct = pprPanic "makeSuperClasses" (ppr ct) mkStrictSuperClasses - :: CtEvidence + :: ExpansionFuel -> CtEvidence -> [TyVar] -> ThetaType -- These two args are non-empty only when taking -- superclasses of a /quantified/ constraint -> Class -> [Type] -> TcS [Ct] -- Return constraints for the strict superclasses of -- ev :: forall as. theta => cls tys -mkStrictSuperClasses ev tvs theta cls tys - = mk_strict_superclasses (unitNameSet (className cls)) +mkStrictSuperClasses fuel ev tvs theta cls tys + = mk_strict_superclasses fuel (unitNameSet (className cls)) ev tvs theta cls tys -mk_strict_superclasses :: NameSet -> CtEvidence +mk_strict_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return the immediate superclasses of (cls tys); -- and expand their superclasses, provided none of them are in rec_clss -- nor are repeated -mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) +mk_strict_superclasses fuel rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) tvs theta cls tys = concatMapM do_one_given $ classSCSelIds cls @@ -542,7 +544,7 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) | otherwise = do { given_ev <- newGivenEvVar sc_loc $ mk_given_desc sel_id sc_pred - ; mk_superclasses rec_clss given_ev tvs theta sc_pred } + ; mk_superclasses fuel rec_clss given_ev tvs theta sc_pred } where sc_pred = classMethodInstTy sel_id tys @@ -603,7 +605,7 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) newly_blocked (InstSkol _ head_size) = isJust (this_size `ltPatersonSize` head_size) newly_blocked _ = False -mk_strict_superclasses rec_clss ev tvs theta cls tys +mk_strict_superclasses fuel rec_clss ev tvs theta cls tys | all noFreeVarsOfType tys = return [] -- Wanteds with no variables yield no superclass constraints. -- See Note [Improvement from Ground Wanteds] @@ -618,7 +620,7 @@ mk_strict_superclasses rec_clss ev tvs theta cls tys do_one sc_pred = do { traceTcS "mk_strict_superclasses Wanted" (ppr (mkClassPred cls tys) $$ ppr sc_pred) ; sc_ev <- newWantedNC loc (ctEvRewriters ev) sc_pred - ; mk_superclasses rec_clss sc_ev [] [] sc_pred } + ; mk_superclasses fuel rec_clss sc_ev [] [] sc_pred } {- Note [Improvement from Ground Wanteds] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -633,29 +635,29 @@ dependencies. See Note [Why adding superclasses can help] above. But no variables means no improvement; case closed. -} -mk_superclasses :: NameSet -> CtEvidence +mk_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> PredType -> TcS [Ct] -- Return this constraint, plus its superclasses, if any -mk_superclasses rec_clss ev tvs theta pred +mk_superclasses fuel rec_clss ev tvs theta pred | ClassPred cls tys <- classifyPredType pred - = mk_superclasses_of rec_clss ev tvs theta cls tys + = mk_superclasses_of fuel rec_clss ev tvs theta cls tys | otherwise -- Superclass is not a class predicate = return [mkNonCanonical ev] -mk_superclasses_of :: NameSet -> CtEvidence +mk_superclasses_of :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return this class constraint, -- and expand its superclasses -mk_superclasses_of rec_clss ev tvs theta cls tys +mk_superclasses_of fuel rec_clss ev tvs theta cls tys | loop_found = do { traceTcS "mk_superclasses_of: loop" (ppr cls <+> ppr tys) ; return [this_ct] } -- cc_pend_sc of this_ct = True | otherwise = do { traceTcS "mk_superclasses_of" (vcat [ ppr cls <+> ppr tys , ppr (isCTupleClass cls) , ppr rec_clss ]) - ; sc_cts <- mk_strict_superclasses rec_clss' ev tvs theta cls tys + ; sc_cts <- mk_strict_superclasses fuel rec_clss' ev tvs theta cls tys ; return (this_ct : sc_cts) } -- cc_pend_sc of this_ct = False where @@ -664,9 +666,12 @@ mk_superclasses_of rec_clss ev tvs theta cls tys -- Tuples never contribute to recursion, and can be nested rec_clss' = rec_clss `extendNameSet` cls_nm + this_cc_pend | loop_found = fuel + | otherwise = 0 + this_ct | null tvs, null theta = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys - , cc_pend_sc = loop_found } + , cc_pend_sc = this_cc_pend } -- NB: If there is a loop, we cut off, so we have not -- added the superclasses, hence cc_pend_sc = True | otherwise @@ -827,7 +832,7 @@ canForAllNC :: CtEvidence -> [TyVar] -> TcThetaType -> TcPredType canForAllNC ev tvs theta pred | isGiven ev -- See Note [Eagerly expand given superclasses] , Just (cls, tys) <- cls_pred_tys_maybe - = do { sc_cts <- mkStrictSuperClasses ev tvs theta cls tys + = do { sc_cts <- mkStrictSuperClasses defaultExpansionFuel ev tvs theta cls tys ; emitWork sc_cts ; canForAll ev False } ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -534,8 +534,8 @@ get_sc_pending this_lvl ic@(IC { inert_dicts = dicts, inert_insts = insts }) (sc_pend_insts, insts') = mapAccumL get_pending_inst [] insts - get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc = True - -- but flipping the flag + get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc > 0 + -- but decrementing the fuel get_pending dict dicts | Just dict' <- pendingScDict_maybe dict , belongs_to_this_level (ctEvidence dict) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -10,7 +10,7 @@ module GHC.Tc.Types.Constraint ( QCInst(..), pendingScInst_maybe, -- Canonical constraints - Xi, Ct(..), Cts, + Xi, Ct(..), Cts, ExpansionFuel, noExpansionFuel, defaultExpansionFuel, emptyCts, andCts, andManyCts, pprCts, singleCt, listToCts, ctsElts, consCts, snocCts, extendCtsList, isEmptyCts, @@ -191,6 +191,15 @@ type Xi = TcType type Cts = Bag Ct +-- | Says how many layers of superclasses can we expand. +-- see T21909 +type ExpansionFuel = Int + +noExpansionFuel, defaultExpansionFuel :: Int +noExpansionFuel = 0 +defaultExpansionFuel = 3 + + data Ct -- Atomic canonical constraints = CDictCan { -- e.g. Num ty @@ -199,10 +208,10 @@ data Ct cc_class :: Class, cc_tyargs :: [Xi], -- cc_tyargs are rewritten w.r.t. inerts, so Xi - cc_pend_sc :: Bool + cc_pend_sc :: ExpansionFuel -- See Note [The superclass story] in GHC.Tc.Solver.Canonical - -- True <=> (a) cc_class has superclasses - -- (b) we have not (yet) added those + -- n > 0 <=> (a) cc_class has superclasses + -- (b) we have not (yet) added those -- superclasses as Givens } @@ -673,8 +682,8 @@ instance Outputable Ct where CEqCan {} -> text "CEqCan" CNonCanonical {} -> text "CNonCanonical" CDictCan { cc_pend_sc = psc } - | psc -> text "CDictCan(psc)" - | otherwise -> text "CDictCan" + | psc > 0 -> text "CDictCan" <> parens (text "psc" <+> ppr psc) + | otherwise -> text "CDictCan" CIrredCan { cc_reason = reason } -> text "CIrredCan" <> ppr reason CQuantCan (QCI { qci_pend_sc = pend_sc }) | pend_sc -> text "CQuantCan(psc)" @@ -893,16 +902,17 @@ isUserTypeError pred = case getUserTypeErrorMsg pred of _ -> False isPendingScDict :: Ct -> Bool -isPendingScDict (CDictCan { cc_pend_sc = psc }) = psc --- Says whether this is a CDictCan with cc_pend_sc is True; +isPendingScDict (CDictCan { cc_pend_sc = psc }) = psc > 0 +-- Says whether this is a CDictCan with cc_pend_sc has positive fuel; -- i.e. pending un-expanded superclasses isPendingScDict _ = False pendingScDict_maybe :: Ct -> Maybe Ct --- Says whether this is a CDictCan with cc_pend_sc is True, +-- Says whether this is a CDictCan with cc_pend_sc has fuel left, -- AND if so flips the flag -pendingScDict_maybe ct@(CDictCan { cc_pend_sc = True }) - = Just (ct { cc_pend_sc = False }) +pendingScDict_maybe ct@(CDictCan { cc_pend_sc = n }) + | n > 0 = Just (ct { cc_pend_sc = n - 1 }) + | otherwise = Nothing pendingScDict_maybe _ = Nothing pendingScInst_maybe :: QCInst -> Maybe QCInst ===================================== testsuite/tests/typecheck/should_compile/T21909.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +module T21909 where + +import Data.Kind + +class (Monad m, MyMonad (Inner m)) => MyMonad m where + type Inner m :: Type -> Type + foo :: m Int + +works :: MyMonad m => m String +works = show <$> ((+ 1) <$> foo) + +fails :: MyMonad m => m String +fails = show <$> fooPlusOne + where + fooPlusOne = (+ 1) <$> foo + +alsoFails :: MyMonad m => m String +alsoFails = + let fooPlusOne = (+ 1) <$> foo + in show <$> fooPlusOne ===================================== testsuite/tests/typecheck/should_compile/T21909b.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableSuperClasses, FunctionalDependencies, MultiParamTypeClasses, GADTs #-} + +module T21909b where + +import Data.Kind + +class C [a] => C a where + foo :: a -> Int + +should_work :: C a => a -> Int +should_work x = foolocal x + where + foolocal a = foo a ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -857,3 +857,5 @@ test('T22647', normal, compile, ['']) test('T19577', normal, compile, ['']) test('T22383', normal, compile, ['']) test('T21501', normal, compile, ['']) +test('T21909', normal, compile, ['']) +test('T21909b', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/93d04d3eb5d8a32ef122c298ab3ddacc67305d39 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/93d04d3eb5d8a32ef122c298ab3ddacc67305d39 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 22:13:11 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Mon, 06 Feb 2023 17:13:11 -0500 Subject: [Git][ghc/ghc][wip/andreask/infer-bytecode] Fix some correctness issues around tag inference when targeting the bytecode generator. Message-ID: <63e17b7751e39_1108fe56cecbdc13587e5@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/infer-bytecode at Glasgow Haskell Compiler / GHC Commits: 382bd7da by Andreas Klebinger at 2023-02-06T23:12:25+01:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9 changed files: - compiler/GHC/Driver/Config/Stg/Pipeline.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Types.hs - compiler/GHC/Stg/Pipeline.hs - + testsuite/tests/simplStg/should_compile/T22840.hs - + testsuite/tests/simplStg/should_compile/T22840.stderr - + testsuite/tests/simplStg/should_compile/T22840A.hs - + testsuite/tests/simplStg/should_compile/T22840B.hs - testsuite/tests/simplStg/should_compile/all.T Changes: ===================================== compiler/GHC/Driver/Config/Stg/Pipeline.hs ===================================== @@ -22,6 +22,7 @@ initStgPipelineOpts dflags for_bytecode = StgPipelineOpts , stgPipeline_pprOpts = initStgPprOpts dflags , stgPipeline_phases = getStgToDo for_bytecode dflags , stgPlatform = targetPlatform dflags + , stgPipeline_forBytecode = for_bytecode } -- | Which Stg-to-Stg passes to run. Depends on flags, ways etc. ===================================== compiler/GHC/Stg/InferTags.hs ===================================== @@ -204,6 +204,33 @@ a different StgPass! To handle this a large part of the analysis is polymorphic over the exact StgPass we are using. Which allows us to run the analysis on the output of itself. +Note [Tag inference for interpreted code] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The bytecode interpreter has a different behaviour when it comes +to the tagging of binders in certain situations than the StgToCmm code generator. + +a) Tags for let-bindings: + + When compiling a binding for a constructor like `let x = Just True` + Weither or not `x` results in x pointing depends on the backend. + For the interpreter x points to a BCO which once + evaluated returns a properly tagged pointer to the heap object. + In the Cmm backend for the same binding we would allocate the constructor right + away and x will immediately be represented by a tagged pointer. + This means for interpreted code we can not assume let bound constructors are + properly tagged. Hence we distinguish between targeting bytecode and native in + the analysis. + We make this differentiation in `mkLetSig` where we simply never assume + lets are tagged when targeting bytecode. + +b) When referencing ids from other modules the Cmm backend will try to put a + proper tag on these references through various means. When doing analysis we + usually predict these cases to improve precision of the analysis. + But to my knowledge the bytecode generator makes no such attempts so we must + not infer imported bindings as tagged. + This is handled in GHC.Stg.InferTags.Types.lookupInfo + + -} {- ********************************************************************* @@ -212,20 +239,12 @@ the output of itself. * * ********************************************************************* -} --- doCodeGen :: HscEnv -> Module -> InfoTableProvMap -> [TyCon] --- -> CollectedCCs --- -> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs --- -> HpcInfo --- -> IO (Stream IO CmmGroupSRTs CmmCgInfos) --- -- Note we produce a 'Stream' of CmmGroups, so that the --- -- backend can be run incrementally. Otherwise it generates all --- -- the C-- up front, which has a significant space cost. -inferTags :: StgPprOpts -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) -inferTags ppr_opts logger this_mod stg_binds = do - +inferTags :: StgPprOpts -> Bool -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) +inferTags ppr_opts !for_bytecode logger this_mod stg_binds = do + -- pprTraceM "inferTags for " (ppr this_mod <> text " bytecode:" <> ppr for_bytecode) -- Annotate binders with tag information. let (!stg_binds_w_tags) = {-# SCC "StgTagFields" #-} - inferTagsAnal stg_binds + inferTagsAnal for_bytecode stg_binds putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings ppr_opts stg_binds_w_tags) let export_tag_info = collectExportInfo stg_binds_w_tags @@ -254,10 +273,10 @@ type InferExtEq i = ( XLet i ~ XLet 'InferTaggedBinders , XLetNoEscape i ~ XLetNoEscape 'InferTaggedBinders , XRhsClosure i ~ XRhsClosure 'InferTaggedBinders) -inferTagsAnal :: [GenStgTopBinding 'CodeGen] -> [GenStgTopBinding 'InferTaggedBinders] -inferTagsAnal binds = +inferTagsAnal :: Bool -> [GenStgTopBinding 'CodeGen] -> [GenStgTopBinding 'InferTaggedBinders] +inferTagsAnal for_bytecode binds = -- pprTrace "Binds" (pprGenStgTopBindings shortStgPprOpts $ binds) $ - snd (mapAccumL inferTagTopBind initEnv binds) + snd (mapAccumL inferTagTopBind (initEnv for_bytecode) binds) ----------------------- inferTagTopBind :: TagEnv 'CodeGen -> GenStgTopBinding 'CodeGen @@ -420,11 +439,12 @@ inferTagBind in_env (StgNonRec bndr rhs) -- ppr bndr $$ -- ppr (isDeadEndId id) $$ -- ppr sig) - (env', StgNonRec (id, sig) rhs') + (env', StgNonRec (id, out_sig) rhs') where id = getBinderId in_env bndr - env' = extendSigEnv in_env [(id, sig)] - (sig,rhs') = inferTagRhs id in_env rhs + (in_sig,rhs') = inferTagRhs id in_env rhs + out_sig = mkLetSig in_env in_sig + env' = extendSigEnv in_env [(id, out_sig)] inferTagBind in_env (StgRec pairs) = -- pprTrace "rec" (ppr (map fst pairs) $$ ppr (in_env { te_env = out_env }, StgRec pairs')) $ @@ -443,14 +463,17 @@ inferTagBind in_env (StgRec pairs) | in_sigs == out_sigs = (te_env rhs_env, out_bndrs `zip` rhss') | otherwise = go env' out_sigs rhss' where - out_bndrs = map updateBndr in_bndrs -- TODO: Keeps in_ids alive in_bndrs = in_ids `zip` in_sigs + out_bndrs = map updateBndr in_bndrs -- TODO: Keeps in_ids alive rhs_env = extendSigEnv go_env in_bndrs (out_sigs, rhss') = unzip (zipWithEqual "inferTagBind" anaRhs in_ids go_rhss) env' = makeTagged go_env anaRhs :: Id -> GenStgRhs q -> (TagSig, GenStgRhs 'InferTaggedBinders) - anaRhs bnd rhs = inferTagRhs bnd rhs_env rhs + anaRhs bnd rhs = + let (sig_rhs,rhs') = inferTagRhs bnd rhs_env rhs + in (mkLetSig go_env sig_rhs, rhs') + updateBndr :: (Id,TagSig) -> (Id,TagSig) updateBndr (v,sig) = (setIdTagSig v sig, sig) @@ -536,6 +559,15 @@ inferTagRhs _ env _rhs@(StgRhsCon cc con cn ticks args) = --pprTrace "inferTagRhsCon" (ppr grp_ids) $ (TagSig (inferConTag env con args), StgRhsCon cc con cn ticks args) +-- Adjust let semantics to the targeted backend. +-- See Note [Tag inference for interpreted code] +mkLetSig :: TagEnv p -> TagSig -> TagSig +mkLetSig env in_sig + | for_bytecode = TagSig TagDunno + | otherwise = in_sig + where + for_bytecode = te_bytecode env + {- Note [Constructor TagSigs] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @inferConTag@ will infer the proper tag signature for a binding who's RHS is a constructor ===================================== compiler/GHC/Stg/InferTags/Types.hs ===================================== @@ -49,24 +49,30 @@ combineAltInfo ti TagTagged = ti type TagSigEnv = IdEnv TagSig data TagEnv p = TE { te_env :: TagSigEnv , te_get :: BinderP p -> Id + , te_bytecode :: !Bool } instance Outputable (TagEnv p) where - ppr te = ppr (te_env te) - + ppr te = for_txt <+> ppr (te_env te) + where + for_txt = if te_bytecode te + then text "for_bytecode" + else text "for_native" getBinderId :: TagEnv p -> BinderP p -> Id getBinderId = te_get -initEnv :: TagEnv 'CodeGen -initEnv = TE { te_env = emptyVarEnv - , te_get = \x -> x} +initEnv :: Bool -> TagEnv 'CodeGen +initEnv for_bytecode = TE { te_env = emptyVarEnv + , te_get = \x -> x + , te_bytecode = for_bytecode } -- | Simple convert env to a env of the 'InferTaggedBinders pass -- with no other changes. makeTagged :: TagEnv p -> TagEnv 'InferTaggedBinders makeTagged env = TE { te_env = te_env env - , te_get = fst } + , te_get = fst + , te_bytecode = te_bytecode env } noSig :: TagEnv p -> BinderP p -> (Id, TagSig) noSig env bndr @@ -75,14 +81,18 @@ noSig env bndr where var = getBinderId env bndr +-- | Look up a sig in the given env lookupSig :: TagEnv p -> Id -> Maybe TagSig lookupSig env fun = lookupVarEnv (te_env env) fun +-- | Look up a sig in the env or derive it from information +-- in the arg itself. lookupInfo :: TagEnv p -> StgArg -> TagInfo lookupInfo env (StgVarArg var) -- Nullary data constructors like True, False | Just dc <- isDataConWorkId_maybe var , isNullaryRepDataCon dc + , not for_bytecode = TagProper | isUnliftedType (idType var) @@ -93,6 +103,7 @@ lookupInfo env (StgVarArg var) = info | Just lf_info <- idLFInfo_maybe var + , not for_bytecode = case lf_info of -- Function, tagged (with arity) LFReEntrant {} @@ -112,6 +123,8 @@ lookupInfo env (StgVarArg var) | otherwise = TagDunno + where + for_bytecode = te_bytecode env lookupInfo _ (StgLitArg {}) = TagProper ===================================== compiler/GHC/Stg/Pipeline.hs ===================================== @@ -50,6 +50,7 @@ data StgPipelineOpts = StgPipelineOpts -- ^ Should we lint the STG at various stages of the pipeline? , stgPipeline_pprOpts :: !StgPprOpts , stgPlatform :: !Platform + , stgPipeline_forBytecode :: !Bool } newtype StgM a = StgM { _unStgM :: ReaderT Char IO a } @@ -89,7 +90,7 @@ stg2stg logger extra_vars opts this_mod binds -- annotations (which is used by code generator to compute offsets into closures) ; let binds_sorted_with_fvs = depSortWithAnnotStgPgm this_mod binds' -- See Note [Tag inference for interactive contexts] - ; inferTags (stgPipeline_pprOpts opts) logger this_mod binds_sorted_with_fvs + ; inferTags (stgPipeline_pprOpts opts) (stgPipeline_forBytecode opts) logger this_mod binds_sorted_with_fvs } where ===================================== testsuite/tests/simplStg/should_compile/T22840.hs ===================================== @@ -0,0 +1,14 @@ +{-# OPTIONS_GHC -fwrite-if-simplified-core -fbyte-code-and-object-code -fprefer-byte-code #-} +{-# LANGUAGE TemplateHaskell #-} + +module C where + +import T22840A +import T22840B +import Control.Monad.IO.Class + +$(liftIO $ do + putStrLn "start" + putStrLn (disp theT) + putStrLn "end" + return []) ===================================== testsuite/tests/simplStg/should_compile/T22840.stderr ===================================== @@ -0,0 +1,6 @@ +[1 of 3] Compiling T22840A ( T22840A.hs, T22840A.o, T22840A.dyn_o ) +[2 of 3] Compiling T22840B ( T22840B.hs, T22840B.o, T22840B.dyn_o, interpreted ) +[3 of 3] Compiling C ( T22840.hs, T22840.o, T22840.dyn_o, interpreted ) +start +Just +end ===================================== testsuite/tests/simplStg/should_compile/T22840A.hs ===================================== @@ -0,0 +1,9 @@ +module T22840A where + +data T = MkT !(Maybe Bool) + +disp :: T -> String +disp (MkT b) = + case b of + Nothing -> "Nothing" + Just _ -> "Just" ===================================== testsuite/tests/simplStg/should_compile/T22840B.hs ===================================== @@ -0,0 +1,8 @@ +{-# OPTIONS_GHC -fwrite-if-simplified-core -fbyte-code-and-object-code -fprefer-byte-code #-} + +module T22840B where + +import T22840A + +theT :: T +theT = MkT (Just True) ===================================== testsuite/tests/simplStg/should_compile/all.T ===================================== @@ -14,3 +14,7 @@ test('T19717', normal, compile, ['-ddump-stg-final -dsuppress-uniques -dno-typea test('inferTags002', [ only_ways(['optasm']), grep_errmsg(r'(call stg\_ap\_0)', [1])], compile, ['-ddump-cmm -dsuppress-uniques -dno-typeable-binds -O']) test('T22212', normal, compile, ['-O']) +test('T22840', [extra_files( + [ 'T22840A.hs' + , 'T22840B.hs' + ]), when(not(have_dynamic()),skip)], multimod_compile, ['T22840', '-dynamic-too -dtag-inference-checks']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/382bd7dad9cd53254204f418190368667a127f64 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/382bd7dad9cd53254204f418190368667a127f64 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 23:00:43 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Mon, 06 Feb 2023 18:00:43 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/az/T22919-module-where Message-ID: <63e1869b5b4af_1108fe5265c136292b@gitlab.mail> Alan Zimmerman pushed new branch wip/az/T22919-module-where at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/az/T22919-module-where You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 23:08:46 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Mon, 06 Feb 2023 18:08:46 -0500 Subject: [Git][ghc/ghc][wip/t21766] 15 commits: Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" Message-ID: <63e1887e1a3d7_1108fe617239c013686da@gitlab.mail> Finley McIlwaine pushed to branch wip/t21766 at Glasgow Haskell Compiler / GHC Commits: 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - c7479ef0 by Finley McIlwaine at 2023-02-06T12:01:35-07:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - 99a13503 by Finley McIlwaine at 2023-02-06T12:01:35-07:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - 11f522e7 by Finley McIlwaine at 2023-02-06T12:01:35-07:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - 76a2dd73 by Finley McIlwaine at 2023-02-06T12:01:35-07:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - d3a60b7b by Finley McIlwaine at 2023-02-06T12:01:35-07:00 Add note describing IPE data compression See ticket #21766 - - - - - 715ffb7e by Finley McIlwaine at 2023-02-06T12:01:35-07:00 Fix byte order of IPE data, fix IPE tests Make sure byte order of written IPE buffer entries matches target. Make sure the IPE-related tests properly access the fields of IPE buffer entry nodes with the new IPE layout. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. See ticket #21766. - - - - - 42127861 by Finley McIlwaine at 2023-02-06T15:55:55-07:00 Fix IPE data decompression buffer allocation Capacity of buffers allocated for decompressed IPE data was incorrect due to a misuse of the `ZSTD_findFrameCompressedSize` function. Fix by always storing decompressed size of IPE data in IPE buffer list nodes and using `ZSTD_findFrameCompressedSize` to determine the size of the compressed data. See ticket #21766 - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Data/List/SetOps.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/Iface/Env.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Stg/Lift/Monad.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/SysTools/Terminal.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/ghc.cabal.in - config.sub - configure.ac - docs/users_guide/exts/roles.rst - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/56b0d3ac6118f0bfac654ec85c2dcc3dbb27bc4e...42127861a47f3e9e939d7448f5ba6b68324c92b4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/56b0d3ac6118f0bfac654ec85c2dcc3dbb27bc4e...42127861a47f3e9e939d7448f5ba6b68324c92b4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 6 23:42:18 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Mon, 06 Feb 2023 18:42:18 -0500 Subject: [Git][ghc/ghc][wip/t21766] Fix IPE data decompression buffer allocation Message-ID: <63e1905a1cd4e_1108fe5265c1369577@gitlab.mail> Finley McIlwaine pushed to branch wip/t21766 at Glasgow Haskell Compiler / GHC Commits: 921e9536 by Finley McIlwaine at 2023-02-06T16:41:30-07:00 Fix IPE data decompression buffer allocation Capacity of buffers allocated for decompressed IPE data was incorrect due to a misuse of the `ZSTD_findFrameCompressedSize` function. Fix by always storing decompressed size of IPE data in IPE buffer list nodes and using `ZSTD_findFrameCompressedSize` to determine the size of the compressed data. See ticket #21766 - - - - - 4 changed files: - compiler/GHC/StgToCmm/InfoTableProv.hs - rts/IPE.c - rts/IPE.h - rts/include/rts/IPE.h Changes: ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -98,8 +98,11 @@ emitIpeBufferListNode this_mod ents = do strings :: [CmmStatic] strings = [CmmString strings_bytes] + uncompressed_entries :: BS.ByteString + uncompressed_entries = toIpeBufferEntries (platformByteOrder platform) cg_ipes + entries_bytes :: BS.ByteString - entries_bytes = toIpeBufferEntries (platformByteOrder platform) cg_ipes + entries_bytes = compress defaultCompressionLevel uncompressed_entries entries :: [CmmStatic] entries = [CmmString entries_bytes] @@ -124,14 +127,14 @@ emitIpeBufferListNode this_mod ents = do -- 'entries' field , CmmLabel entries_lbl - -- 'entries_size' field - , int $ BS.length entries_bytes + -- 'entries_size' field (decompressed size) + , int $ BS.length uncompressed_entries -- 'string_table' field , CmmLabel strings_lbl - -- 'string_table_size' field - , int $ BS.length strings_bytes + -- 'string_table_size' field (decompressed size) + , int $ BS.length uncompressed_strings ] -- Emit the list of info table pointers @@ -155,15 +158,12 @@ emitIpeBufferListNode this_mod ents = do (CmmStaticsRaw ipe_buffer_lbl ipe_buffer_node) -- | Emit the fields of an IpeBufferEntry struct for each entry in a given list. --- The fields are converted to a bytestring and compressed. If compression is --- not enabled, the compression step is simply @id at . toIpeBufferEntries :: ByteOrder -- ^ Byte order to write the data in -> [CgInfoProvEnt] -- ^ List of IPE buffer entries -> BS.ByteString toIpeBufferEntries byte_order cg_ipes = - compress defaultCompressionLevel - . BSL.toStrict . BSB.toLazyByteString . mconcat + BSL.toStrict . BSB.toLazyByteString . mconcat $ map (mconcat . map word32Builder . to_ipe_buf_ent) cg_ipes where to_ipe_buf_ent :: CgInfoProvEnt -> [Word32] ===================================== rts/IPE.c ===================================== @@ -110,11 +110,17 @@ void dumpIPEToEventLog(void) { // Dump pending entries IpeBufferListNode *cursor = RELAXED_LOAD(&ipeBufferList); while (cursor != NULL) { + IpeBufferEntry *entries; + char *strings; + + // Decompress if compressed + decompressIPEBufferListNodeIfCompressed(cursor, &entries, &strings); + for (uint32_t i = 0; i < cursor->count; i++) { const InfoProvEnt ent = ipeBufferEntryToIpe( - cursor->string_table, + strings, cursor->tables[i], - cursor->entries[i] + entries[i] ); traceIPE(&ent); } @@ -180,55 +186,11 @@ void updateIpeMap() { while (pending != NULL) { IpeBufferListNode *current_node = pending; - const char *strings; const IpeBufferEntry *entries; - if (current_node->compressed) { - // The IPE list buffer node indicates that the strings table and - // entries list has been compressed. If zstd is not available, fail. - // If zstd is available, decompress. -#if HAVE_LIBZSTD == 0 - barf("An IPE buffer list node has been compressed, but the \ - decompression library (zstd) is not available."); -#else - size_t decompressed_sz = ZSTD_findFrameCompressedSize( - current_node->string_table, - current_node->string_table_size - ); - char *decompressed_strings = stgMallocBytes( - decompressed_sz, - "updateIpeMap: decompressed_strings" - ); - ZSTD_decompress( - decompressed_strings, - decompressed_sz, - current_node->string_table, - current_node->string_table_size - ); - strings = decompressed_strings; - - // Decompress the IPE data - decompressed_sz = ZSTD_findFrameCompressedSize( - current_node->entries, - current_node->entries_size - ); - void *decompressed_entries = stgMallocBytes( - decompressed_sz, - "updateIpeMap: decompressed_entries" - ); - ZSTD_decompress( - decompressed_entries, - decompressed_sz, - current_node->entries, - current_node->entries_size - ); - entries = decompressed_entries; -#endif // HAVE_LIBZSTD == 0 + const char *strings; - } else { - // Not compressed, no need to decompress - strings = current_node->string_table; - entries = current_node->entries; - } + // Decompress if compressed + decompressIPEBufferListNodeIfCompressed(current_node, &entries, &strings); // Convert the on-disk IPE buffer entry representation (IpeBufferEntry) // into the runtime representation (InfoProvEnt) @@ -248,3 +210,59 @@ void updateIpeMap() { RELEASE_LOCK(&ipeMapLock); } + +/* Decompress the IPE data and strings table referenced by an IPE buffer list +node if it is compressed. No matter whether the data is compressed, the pointers +referenced by the 'entries_dst' and 'string_table_dst' parameters will point at +the decompressed IPE data and string table for the given node, respectively, +upon return from this function. +*/ +void decompressIPEBufferListNodeIfCompressed(IpeBufferListNode *node, IpeBufferEntry **entries_dst, char **string_table_dst) { + if (node->compressed) { + // The IPE list buffer node indicates that the strings table and + // entries list has been compressed. If zstd is not available, fail. + // If zstd is available, decompress. +#if HAVE_LIBZSTD == 0 + barf("An IPE buffer list node has been compressed, but the \ + decompression library (zstd) is not available."); +#else + size_t compressed_sz = ZSTD_findFrameCompressedSize( + node->string_table, + node->string_table_size + ); + char *decompressed_strings = stgMallocBytes( + node->string_table_size, + "updateIpeMap: decompressed_strings" + ); + ZSTD_decompress( + decompressed_strings, + node->string_table_size, + node->string_table, + compressed_sz + ); + *string_table_dst = decompressed_strings; + + // Decompress the IPE data + compressed_sz = ZSTD_findFrameCompressedSize( + node->entries, + node->entries_size + ); + void *decompressed_entries = stgMallocBytes( + node->entries_size, + "updateIpeMap: decompressed_entries" + ); + ZSTD_decompress( + decompressed_entries, + node->entries_size, + node->entries, + compressed_sz + ); + *entries_dst = decompressed_entries; +#endif // HAVE_LIBZSTD == 0 + + } else { + // Not compressed, no need to decompress + *entries_dst = node->entries; + *string_table_dst = node->string_table; + } +} ===================================== rts/IPE.h ===================================== @@ -17,5 +17,6 @@ void dumpIPEToEventLog(void); void updateIpeMap(void); void initIpe(void); void exitIpe(void); +void decompressIPEBufferListNodeIfCompressed(IpeBufferListNode*, IpeBufferEntry**, char**); #include "EndPrivate.h" ===================================== rts/include/rts/IPE.h ===================================== @@ -79,10 +79,10 @@ typedef struct IpeBufferListNode_ { StgInfoTable **tables; IpeBufferEntry *entries; - StgWord entries_size; + StgWord entries_size; // decompressed size char *string_table; - StgWord string_table_size; + StgWord string_table_size; // decompressed size } IpeBufferListNode; void registerInfoProvList(IpeBufferListNode *node); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/921e9536350c9210fae2604a603d214b3c673ca6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/921e9536350c9210fae2604a603d214b3c673ca6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 05:23:53 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 07 Feb 2023 00:23:53 -0500 Subject: [Git][ghc/ghc][wip/js-rts-fixmes] 17 commits: Windows: Remove mingwex dependency Message-ID: <63e1e069aa601_1108fe5ddd5ad8138313@gitlab.mail> Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC Commits: de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - fb3b8d3d by Josh Meredith at 2023-02-07T05:23:40+00:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} - - - - - a9354fdc by Josh Meredith at 2023-02-07T05:23:40+00:00 Cache names used commonly in JS backend RTS generation - - - - - cbfd3028 by Sylvain Henry at 2023-02-07T05:23:40+00:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 0fab9ce0 by Josh Meredith at 2023-02-07T05:23:40+00:00 JS/Make: reduce cache sizes - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Data/List/SetOps.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Env.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/JS/Make.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Stg/Lift/Monad.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/SysTools/Terminal.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Types/CostCentre.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/acbeb4331ed19fb5406b381a8a9c2d87fd290381...0fab9ce0641691c390dcb327813da50c5da1f692 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/acbeb4331ed19fb5406b381a8a9c2d87fd290381...0fab9ce0641691c390dcb327813da50c5da1f692 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 10:20:51 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 07 Feb 2023 05:20:51 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: JS: replace "js" architecture with "javascript" Message-ID: <63e226032fd0c_1108fe56cecbdc141638f@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - 594bda5d by sheaf at 2023-02-07T05:20:45-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 28c5c7d3 by romes at 2023-02-07T05:20:45-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Parser/Lexer.x - config.sub - configure.ac - docs/users_guide/9.6.1-notes.rst - docs/users_guide/exts/roles.rst - hadrian/bindist/config.mk.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - libraries/base/Control/Concurrent.hs - libraries/base/GHC/Conc/IO.hs - libraries/base/GHC/Conc/Windows.hs - libraries/base/GHC/Event.hs - libraries/base/GHC/Event/Thread.hs - libraries/base/GHC/Event/TimerManager.hs - libraries/base/GHC/IO/Encoding.hs - libraries/base/GHC/IO/Encoding/CodePage/API.hs - libraries/base/GHC/IO/FD.hs - libraries/base/GHC/JS/Prim.hs - libraries/base/GHC/JS/Prim/Internal/Build.hs - libraries/base/GHC/Stack/CCS.hsc - libraries/base/GHC/TopHandler.hs - libraries/base/GHC/Windows.hs - libraries/base/System/CPUTime.hsc - libraries/base/System/Environment.hs - libraries/base/System/Environment/ExecutablePath.hsc - libraries/base/System/Posix/Internals.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6c2a5ec25742b5175304f7c5652be8a04d3efab6...28c5c7d3bbd80090abdaa2a1fbd1421d2b3e5c5f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6c2a5ec25742b5175304f7c5652be8a04d3efab6...28c5c7d3bbd80090abdaa2a1fbd1421d2b3e5c5f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 11:30:34 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Tue, 07 Feb 2023 06:30:34 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T22856 Message-ID: <63e2365ae2821_1108fe5ddd5ad81441950@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/T22856 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22856 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 13:11:59 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Tue, 07 Feb 2023 08:11:59 -0500 Subject: [Git][ghc/ghc][wip/9.2.6-backports] Bump version to GHC 9.2.6 and add changelog entries Message-ID: <63e24e1fefb54_1108fe5ddd5ad814814f3@gitlab.mail> Zubin pushed to branch wip/9.2.6-backports at Glasgow Haskell Compiler / GHC Commits: 25ee3849 by Zubin Duggal at 2023-02-07T18:40:53+05:30 Bump version to GHC 9.2.6 and add changelog entries - - - - - 4 changed files: - configure.ac - docs/users_guide/9.2.1-notes.rst - + docs/users_guide/9.2.6-notes.rst - docs/users_guide/release-notes.rst Changes: ===================================== configure.ac ===================================== @@ -13,7 +13,7 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.2.5], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.2.6], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Version on HEAD must be X.Y (not X.Y.Z) for ProjectVersionMunged variable # to be useful (cf #19058) ===================================== docs/users_guide/9.2.1-notes.rst ===================================== @@ -45,6 +45,19 @@ Language .. _Unlifted Datatypes Proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0265-unlifted-datatypes.rst +* GHC now supports visible type applications in patterns when :extension:`TypeApplications` is enabled . This allows + you to use the ``@variable`` syntax to bind types in patterns. For instance, instead of :: + + foo (Just (x :: ty)) = … + + You can now use + + foo (Just @ty x) = … + + See the `Type Applications in Patterns Proposal`_ for more details + +.. _Type Applications in Patterns Proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0126-type-applications-in-patterns.rst + * Kind inference for data/newtype instance declarations is slightly more restrictive than before. In particular, GHC now requires that the kind of a data family instance be fully determined by the header of the instance, without looking at the definition of the constructor. ===================================== docs/users_guide/9.2.6-notes.rst ===================================== @@ -0,0 +1,128 @@ +.. _release-9-2-6: + +Version 9.2.6 +============== + +The significant changes to the various parts of the compiler are listed in the +following sections. + +The :ghc-flag:`LLVM backend <-fllvm>` of this release is to be used with LLVM +9, 10, 11, or 12. + +Compiler +-------- + +- Fix a regression in the simplifier due to a bad backport in GHC 9.2.5 that + could seriously impact runtime performance when compiling with optimisations + due to duplication of expensive work (:ghc-ticket:`22425`). + +- Fix a compiler panic in the simplifier due to a bad backport in GHC 9.2.5 + (:ghc-ticket:`22491`). + +- Fix a compiler panic in the simplifier that manifests when compiling with + optimisations (:ghc-ticket:`19824`,:ghc-ticket:`22482`). + +- Fix a compiler panic in the demand analyser due to a bug involving shadowing + (:ghc-ticket:`22718`). + +- Fix a compiler panic during the "Float In" optimsation pass due to improper + handling of shadowing (:ghc-ticket:`22662`). + +- Fix a compiler panic in the demand analyser (:ghc-ticket:`22039`). + +- Fix a shadowing related bug in the occurence analysis phase of the simplifier + (:ghc-ticket:`22623`). + +- Fix a compiler bug where programs using Template Haskell involving Constant + Applicative forms could be garbage collected too early (:ghc-ticket:`22417`). + +- Fix a regression in the typechecker where certain typeclass instances + involving type and data familes would fail to resolve (:ghc-ticket:`22647`). + +- Fix the linker warning about chained fixups on Darwin platforms for programs + compiled with GHC (:ghc-ticket:`22429`). + +- Fix a bug with the graph-colouring register allocater leading to compiler + panics when compiling with ``-fregs-graph`` (:ghc-ticket:`22798`). + +- Fix a parser bug where certain keywords which could be used as variables + were not allowed to be used with :extension:`OverloadedRecordDot` + (:ghc-ticket:`20723`). + +- Fix the location of some ``Typeable`` definitions from ``GHC.Types`` which + resulted in poor error messages (:ghc-ticket:`22510`). + +- Improve error messages involving non-exhaustive patterns when using + :extension:`ApplicativeDo` (:ghc-ticket:`22483`). + +- Fix a driver bug where certain non-fatal Safe Haskell related warnings were + being marked as fatal (:ghc-ticket:`22728`). + +Runtime system +-------------- + +- Fix a GC bug where a race condition in the parallel GC could cause it to + garbage collect live sparks (:ghc-ticket:`22528`). + +- Truncate eventlog events with a large payload (:ghc-ticket:`20221`). + +Build system and packaging +-------------------------- + +- Bump ``gmp-tarballs`` to a version which doesn't use the reserved ``x18`` + register on AArch64/Darwin systems, and also has fixes for CVE-2021-43618 + (:ghc-ticket:`22497`, :ghc-ticket:`22789`). + +- Include haddock documentation in interface files for hadrian generated + bindists, including darwin platforms (:ghc-ticket:`22734`). + +Core libraries +-------------- + +- Bump ``bytestring`` to 0.11.4.0. + +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/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 + + ===================================== docs/users_guide/release-notes.rst ===================================== @@ -9,3 +9,4 @@ Release notes 9.2.3-notes 9.2.4-notes 9.2.5-notes + 9.2.6-notes View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/25ee38493347d44162809716b5ad317942181ff9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/25ee38493347d44162809716b5ad317942181ff9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 13:18:24 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Tue, 07 Feb 2023 08:18:24 -0500 Subject: [Git][ghc/ghc][wip/9.2.6-backports] 29 commits: Fix #22425 - Broken eta-expansion over expensive work. Message-ID: <63e24fa0a5173_1108fec035f014838f0@gitlab.mail> Zubin pushed to branch wip/9.2.6-backports at Glasgow Haskell Compiler / GHC Commits: 6eaf0d3d by Andreas Klebinger at 2023-02-07T18:47:08+05:30 Fix #22425 - Broken eta-expansion over expensive work. This is the 9.2 backport of !9357 Through a mistake in the latest backport we started eta-expanding over expensive work by mistake. E.g. over <expensive> in code like: case x of A -> id B -> <expensive> We fix this by only eta-expanding over <expensive> if all other branches are headed by an oneShot lambda. In the long story of broken eta-expansion on 9.2/9.4 this is hopefully the last chapter. ------------------------- Metric Increase: CoOpt_Read T1969 parsing001 TcPlugin_RewritePerf LargeRecord ------------------------- (cherry picked from commit ce608479c7f40a9899a6448379d05861bee77b41) - - - - - fed9cff1 by Simon Peyton Jones at 2023-02-07T18:47:08+05:30 Add a missing varToCoreExpr in etaBodyForJoinPoint This subtle bug showed up when compiling a library with 9.4. See #22491. The bug is present in master, but it is hard to trigger; the new regression test T22491 fails in 9.4. The fix was easy: just add a missing varToCoreExpr in etaBodyForJoinPoint. The fix is definitely right though! I also did some other minor refatoring: * Moved the preInlineUnconditionally test in simplExprF1 to before the call to joinPointBinding_maybe, to avoid fruitless eta-expansion. * Added a boolean from_lam flag to simplNonRecE, to avoid two fruitless tests, and commented it a bit better. These refactorings seem to save 0.1% on compile-time allocation in perf/compiler; with a max saving of 1.4% in T9961 Metric Decrease: T9961 (cherry picked from commit afc2540daf6ca6baa09ab147b792da08d66d878c) - - - - - ce180d2f by Matthew Pickering at 2023-02-07T18:47:08+05:30 Typeable: Fix module locations of some definitions in GHC.Types There was some confusion in Data.Typeable about which module certain wired-in things were defined in. Just because something is wired-in doesn't mean it comes from GHC.Prim, in particular things like LiftedRep and RuntimeRep are defined in GHC.Types and that's the end of the story. Things like Int#, Float# etc are defined in GHC.Prim as they have no Haskell definition site at all so we need to generate type representations for them (which live in GHC.Types). Fixes #22510 (cherry picked from commit 1d3a8b8ec98e6eedf8943e19780ec374c2491e7f) - - - - - aac592f3 by Andreas Klebinger at 2023-02-07T18:47:08+05:30 Fix LitRubbish being applied to values. This fixes #19824 This is the 9.2 backport of commit 52ce8590ab18fb1fc99bd9aa24c016f786d7f7d1 (cherry picked from commit 2e02959ab40f2b67499aaffc29ee1dc9f0d48158) - - - - - 8aaf86f8 by Simon Peyton Jones at 2023-02-07T18:47:08+05:30 Fix unifier bug: failing to decompose over-saturated type family This simple patch fixes #22647 (cherry picked from commit 317f45c154f6fe25d50ef2f3febcc5883ff1b1ca) - - - - - 03da82af by Sebastian Graf at 2023-02-07T18:47:08+05:30 Handle shadowing in DmdAnal (#22718) Previously, when we had a shadowing situation like ```hs f x = ... -- demand signature <1L><1L> main = ... \f -> f 1 ... ``` we'd happily use the shadowed demand signature at the call site inside the lambda. Of course, that's wrong and solution is simply to remove the demand signature from the `AnalEnv` when we enter the lambda. This patch does so for all binding constructs Core. In #22718 the issue was caused by LetUp not shadowing away the existing demand signature for the let binder in the let body. The resulting absent error is fickle to reproduce; hence no reproduction test case. #17478 would help. Fixes #22718. It appears that TcPlugin_Rewrite regresses by ~40% on Darwin. It is likely that DmdAnal was exploiting ill-scoped analysis results. Metric increase ['bytes allocated'] (test_env=x86_64-darwin-validate): TcPlugin_Rewrite (cherry picked from commit e3fff7512bbf989386faaa1dccafdad1deabde84) - - - - - 7e47d0f5 by Zubin Duggal at 2023-02-07T18:47:09+05:30 Bump bytestring submodule to 0.11.4.0 - - - - - d130b39f by Andreas Klebinger at 2023-02-07T18:47:09+05:30 Only gc sparks locally when we can ensure marking is done. When performing GC without work stealing there was no guarantee that spark pruning was happening after marking of the sparks. This could cause us to GC live sparks under certain circumstances. Fixes #22528. (cherry picked from commit a1491c8791c57a64d94bc08d639d585815c8d4e2) - - - - - 5b2af591 by Ian-Woo Kim at 2023-02-07T18:47:09+05:30 Truncate eventlog event for large payload (#20221) RTS eventlog events for postCapsetVecEvent are truncated if payload is larger than EVENT_PAYLOAD_SIZE_MAX Previously, postCapsetVecEvent records eventlog event with payload of variable size larger than EVENT_PAYLOAD_SIZE_MAX (2^16) without any validation, resulting in corrupted data. For example, this happens when a Haskell binary is invoked with very long command line arguments exceeding 2^16 bytes (see #20221). Now we check the size of accumulated payload messages incrementally, and truncate the message just before the payload size exceeds EVENT_PAYLOAD_SIZE_MAX. RTS will warn the user with a message showing how many arguments are truncated. (cherry picked from commit 2057c77d08cb8422857d182a3691f98dccd0c7d6) - - - - - ec04fbed by Simon Peyton Jones at 2023-02-07T18:47:09+05:30 Make FloatIn robust to shadowing This MR fixes #22622. See the new Note [Shadowing and name capture] I did a bit of refactoring in sepBindsByDropPoint too. The bug doesn't manifest in HEAD, but it did show up in 9.4, so we should backport this patch to 9.4 (cherry picked from commit 6206cb9287f3f6e70c669660a646a65274870d2b) - - - - - a225dbb1 by Ben Gamari at 2023-02-07T18:47:09+05:30 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. (cherry picked from commit f891a442046d8a5ebf4d4777847880ce06752b18) - - - - - cf2da09a by Ben Gamari at 2023-02-07T18:47:09+05:30 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. (cherry picked from commit b13c6ea5d4b64841164f8cc58d6c6f3de390f2ed) - - - - - 09224b90 by Oleg Grenrus at 2023-02-07T18:47:09+05:30 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general (cherry picked from commit 1b812b6973a25cb1962e2fc543d2c4ed3cf31f3c) - - - - - 27f154f9 by Zubin Duggal at 2023-02-07T18:47:09+05:30 Document #22255 and #22468 in bugs.rst - - - - - c63a3e25 by Simon Peyton Jones at 2023-02-07T18:47:09+05:30 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 (cherry picked from commit 3d55d8ab51ece43c51055c43c9e7aba77cce46c0) - - - - - eadbbbcf by Simon Peyton Jones at 2023-02-07T18:47:09+05:30 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. (cherry picked from commit e193e53790dd5886feea3cf4c9c17625d188291b) - - - - - a090f5c3 by Sebastian Graf at 2023-02-07T18:47:09+05:30 DmdAnal: Don't panic in addCaseBndrDmd (#22039) Rather conservatively return Top. See Note [Untyped demand on case-alternative binders]. I also factored `addCaseBndrDmd` into two separate functions `scrutSubDmd` and `fieldBndrDmds`. Fixes #22039. (cherry picked from commit d2be80fd9b222963e8dd09a30f78c106e00da7f9) - - - - - 52e579b6 by Matthew Pickering at 2023-02-07T18:47:09+05:30 ApplicativeDo: Set pattern location before running exhaustiveness checker This improves the error messages of the exhaustiveness checker when checking statements which have been moved around with ApplicativeDo. Before: Test.hs:2:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 2 | let x = () | ^^^^^^^^^^ After: Test.hs:4:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 4 | ~(Just res1) <- seq x (pure $ Nothing @()) | Fixes #22483 (cherry picked from commit 74c767df770766d8d52e87b9ff7da10f94620a91) (cherry picked from commit 51c6051bcc405bc1dbddd450ade949acd70db6b8) - - - - - 96ab827a by Andreas Klebinger at 2023-02-07T18:47:09+05:30 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- (cherry picked from commit 08ba87200ff068aa37cac082e61ee7e2d534daf5) - - - - - 898ca9c6 by Matthew Pickering at 2023-02-07T18:47:09+05:30 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s (cherry picked from commit a960ca817d6ad0109ea6edda50da3902cc538e86) - - - - - 8e0c0da5 by Matthew Pickering at 2023-02-07T18:47:09+05:30 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. (cherry picked from commit 734847108420cf826a807c30ad54651659cf3a08) - - - - - 8ef4fec1 by Matthew Pickering at 2023-02-07T18:47:09+05:30 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes (cherry picked from commit 8c0ea25fb4a27d4729aabf73f4c00b912bb0c58d) - - - - - 2df830a1 by Cheng Shao at 2023-02-07T18:47:09+05:30 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. (cherry picked from commit c45a5fffef2c76efbf5d3a009c3f6d0244a63f0d) - - - - - 15d34a97 by Ben Gamari at 2023-02-07T18:47:09+05:30 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. (cherry picked from commit be417a47c7695998dea0adc05489a7b8838a78b6) - - - - - 34baa6e9 by Ben Gamari at 2023-02-07T18:47:10+05:30 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. (cherry picked from commit 30989d137b8f3a8fddbfd116e04b48f23c24f86c) - - - - - d5eea69c by Ben Gamari at 2023-02-07T18:47:10+05:30 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. (cherry picked from commit 7566fd9de38c67360c090f828923d41587af519c) - - - - - 8d846b8a by Ben Gamari at 2023-02-07T18:47:10+05:30 testsuite: Add regression test for #22798 (cherry picked from commit 2cb500a5ee1a31dfe1a2cdd71f175442026eb082) - - - - - 7262d71f by Zubin Duggal at 2023-02-07T18:47:10+05:30 hadrian: enable -haddock in perf flavour (#22734) - - - - - 0b54f4cd by Zubin Duggal at 2023-02-07T18:47:10+05:30 Bump version to GHC 9.2.6 and add changelog entries - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/cbits/keepCAFsForGHCi.c - compiler/ghc.mk - configure.ac - docs/users_guide/9.2.1-notes.rst - + docs/users_guide/9.2.6-notes.rst - docs/users_guide/bugs.rst - docs/users_guide/release-notes.rst - hadrian/src/Settings/Flavours/Performance.hs - libraries/bytestring - libraries/ghc-bignum/gmp/gmp-tarballs - + m4/fp_ld_no_fixup_chains.m4 - rts/Sparks.c - rts/eventlog/EventLog.c - rts/sm/GC.c - + testsuite/tests/ado/T22483.hs - + testsuite/tests/ado/T22483.stderr - testsuite/tests/ado/all.T - + testsuite/tests/codeGen/should_run/T22798.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/25ee38493347d44162809716b5ad317942181ff9...0b54f4cd66d8c5d2983e6570d82c85674fe6b3c9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/25ee38493347d44162809716b5ad317942181ff9...0b54f4cd66d8c5d2983e6570d82c85674fe6b3c9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 13:21:28 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 07 Feb 2023 08:21:28 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Don't allow . in overloaded labels Message-ID: <63e2505892603_1108fe6d96a63c1485755@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a2d92d95 by sheaf at 2023-02-07T08:21:16-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 82db768a by romes at 2023-02-07T08:21:17-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 7b9365d0 by Ben Gamari at 2023-02-07T08:21:18-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - 7 changed files: - compiler/GHC/Core/TyCon.hs - compiler/GHC/Parser/Lexer.x - docs/users_guide/9.6.1-notes.rst - libraries/base/GHC/Int.hs - libraries/base/GHC/Word.hs - testsuite/tests/overloadedrecflds/should_run/T11671_run.hs - testsuite/tests/printer/Test22771.hs Changes: ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -194,7 +194,7 @@ Note [Type synonym families] * Type synonym families, also known as "type functions", map directly onto the type functions in FC: - type family F a :: * + type family F a :: Type type instance F Int = Bool ..etc... @@ -210,11 +210,11 @@ Note [Type synonym families] type instance F (F Int) = ... -- BAD! * Translation of type family decl: - type family F a :: * + type family F a :: Type translates to a FamilyTyCon 'F', whose FamTyConFlav is OpenSynFamilyTyCon - type family G a :: * where + type family G a :: Type where G Int = Bool G Bool = Char G a = () @@ -229,7 +229,7 @@ Note [Data type families] See also Note [Wrappers for data instance tycons] in GHC.Types.Id.Make * Data type families are declared thus - data family T a :: * + data family T a :: Type data instance T Int = T1 | T2 Bool Here T is the "family TyCon". @@ -321,7 +321,7 @@ See also Note [Wrappers for data instance tycons] in GHC.Types.Id.Make should not think of a data family T as a *type function* at all, not even an injective one! We can't allow even injective type functions on the LHS of a type function: - type family injective G a :: * + type family injective G a :: Type type instance F (G Int) = Bool is no good, even if G is injective, because consider type instance G Int = Bool @@ -572,21 +572,21 @@ Since they are user-callable we must get their type-argument visibility information right; and that info is in the TyConBinders. Here is an example: - data App a b = MkApp (a b) -- App :: forall {k}. (k->*) -> k -> * + data App a b = MkApp (a b) -- App :: forall {k}. (k->Type) -> k -> Type The TyCon has - tyConTyBinders = [ Named (Bndr (k :: *) Inferred), Anon (k->*), Anon k ] + tyConTyBinders = [ Named (Bndr (k :: Type) Inferred), Anon (k->Type), Anon k ] The TyConBinders for App line up with App's kind, given above. But the DataCon MkApp has the type - MkApp :: forall {k} (a:k->*) (b:k). a b -> App k a b + MkApp :: forall {k} (a:k->Type) (b:k). a b -> App k a b That is, its ForAllTyBinders should be - dataConUnivTyVarBinders = [ Bndr (k:*) Inferred - , Bndr (a:k->*) Specified + dataConUnivTyVarBinders = [ Bndr (k:Type) Inferred + , Bndr (a:k->Type) Specified , Bndr (b:k) Specified ] So tyConTyVarBinders converts TyCon's TyConBinders into TyVarBinders: @@ -620,8 +620,8 @@ They fit together like so: type App a (b :: k) = a b - tyConBinders = [ Bndr (k::*) (NamedTCB Inferred) - , Bndr (a:k->*) AnonTCB + tyConBinders = [ Bndr (k::Type) (NamedTCB Inferred) + , Bndr (a:k->Type) AnonTCB , Bndr (b:k) AnonTCB ] Note that there are three binders here, including the @@ -636,13 +636,13 @@ They fit together like so: that TyVar may scope over some other part of the TyCon's definition. Eg type T a = a -> a we have - tyConBinders = [ Bndr (a:*) AnonTCB ] + tyConBinders = [ Bndr (a:Type) AnonTCB ] synTcRhs = a -> a So the 'a' scopes over the synTcRhs * From the tyConBinders and tyConResKind we can get the tyConKind E.g for our App example: - App :: forall k. (k->*) -> k -> * + App :: forall k. (k->Type) -> k -> Type We get a 'forall' in the kind for each NamedTCB, and an arrow for each AnonTCB @@ -725,15 +725,15 @@ instance Binary TyConBndrVis where -- things such as: -- -- 1) Data declarations: @data Foo = ...@ creates the @Foo@ type constructor of --- kind @*@ +-- kind @Type@ -- -- 2) Type synonyms: @type Foo = ...@ creates the @Foo@ type constructor -- -- 3) Newtypes: @newtype Foo a = MkFoo ...@ creates the @Foo@ type constructor --- of kind @* -> *@ +-- of kind @Type -> Type@ -- -- 4) Class declarations: @class Foo where@ creates the @Foo@ type constructor --- of kind @*@ +-- of kind @Constraint@ -- -- This data type also encodes a number of primitive, built in type constructors -- such as those for function and tuple types. @@ -1252,16 +1252,16 @@ data FamTyConFlav -- -- These are introduced by either a top level declaration: -- - -- > data family T a :: * + -- > data family T a :: Type -- -- Or an associated data type declaration, within a class declaration: -- -- > class C a b where - -- > data T b :: * + -- > data T b :: Type DataFamilyTyCon TyConRepName - -- | An open type synonym family e.g. @type family F x y :: * -> *@ + -- | An open type synonym family e.g. @type family F x y :: Type -> Type@ | OpenSynFamilyTyCon -- | A closed type synonym family e.g. ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -163,7 +163,6 @@ $small = [$ascsmall $unismall \_] $uniidchar = \x07 -- Trick Alex into handling Unicode. See Note [Unicode in Alex]. $idchar = [$small $large $digit $uniidchar \'] -$labelchar = [$small $large $digit $uniidchar \' \.] $unigraphic = \x06 -- Trick Alex into handling Unicode. See Note [Unicode in Alex]. $graphic = [$small $large $symbol $digit $idchar $special $unigraphic \"\'] @@ -455,7 +454,7 @@ $unigraphic / { isSmartQuote } { smart_quote_error } } <0> { - "#" $labelchar+ / { ifExtension OverloadedLabelsBit } { skip_one_varid_src ITlabelvarid } + "#" $idchar+ / { ifExtension OverloadedLabelsBit } { skip_one_varid_src ITlabelvarid } "#" \" / { ifExtension OverloadedLabelsBit } { lex_quoted_label } } ===================================== docs/users_guide/9.6.1-notes.rst ===================================== @@ -84,7 +84,7 @@ Language This extends the variety syntax for constructing labels under :extension:`OverloadedLabels`. Examples of newly allowed syntax: - Leading capital letters: `#Foo` equivalant to `getLabel @"Foo"` - - Numeric characters: `#3.14` equivalent to `getLabel @"3.14"` + - Numeric characters: `#1728` equivalent to `getLabel @"1728"` - Arbitrary strings: `#"Hello, World!"` equivalent to `getLabel @"Hello, World!"` Compiler ===================================== libraries/base/GHC/Int.hs ===================================== @@ -69,8 +69,8 @@ instance Eq Int8 where (/=) = neInt8 eqInt8, neInt8 :: Int8 -> Int8 -> Bool -eqInt8 (I8# x) (I8# y) = isTrue# (x `eqInt8#` y) -neInt8 (I8# x) (I8# y) = isTrue# (x `neInt8#` y) +eqInt8 (I8# x) (I8# y) = isTrue# ((int8ToInt# x) ==# (int8ToInt# y)) +neInt8 (I8# x) (I8# y) = isTrue# ((int8ToInt# x) /=# (int8ToInt# y)) {-# INLINE [1] eqInt8 #-} {-# INLINE [1] neInt8 #-} @@ -280,8 +280,8 @@ instance Eq Int16 where (/=) = neInt16 eqInt16, neInt16 :: Int16 -> Int16 -> Bool -eqInt16 (I16# x) (I16# y) = isTrue# (x `eqInt16#` y) -neInt16 (I16# x) (I16# y) = isTrue# (x `neInt16#` y) +eqInt16 (I16# x) (I16# y) = isTrue# ((int16ToInt# x) ==# (int16ToInt# y)) +neInt16 (I16# x) (I16# y) = isTrue# ((int16ToInt# x) /=# (int16ToInt# y)) {-# INLINE [1] eqInt16 #-} {-# INLINE [1] neInt16 #-} @@ -488,8 +488,8 @@ instance Eq Int32 where (/=) = neInt32 eqInt32, neInt32 :: Int32 -> Int32 -> Bool -eqInt32 (I32# x) (I32# y) = isTrue# (x `eqInt32#` y) -neInt32 (I32# x) (I32# y) = isTrue# (x `neInt32#` y) +eqInt32 (I32# x) (I32# y) = isTrue# ((int32ToInt# x) ==# (int32ToInt# y)) +neInt32 (I32# x) (I32# y) = isTrue# ((int32ToInt# x) /=# (int32ToInt# y)) {-# INLINE [1] eqInt32 #-} {-# INLINE [1] neInt32 #-} ===================================== libraries/base/GHC/Word.hs ===================================== @@ -78,8 +78,8 @@ instance Eq Word8 where (/=) = neWord8 eqWord8, neWord8 :: Word8 -> Word8 -> Bool -eqWord8 (W8# x) (W8# y) = isTrue# (x `eqWord8#` y) -neWord8 (W8# x) (W8# y) = isTrue# (x `neWord8#` y) +eqWord8 (W8# x) (W8# y) = isTrue# ((word8ToWord# x) `eqWord#` (word8ToWord# y)) +neWord8 (W8# x) (W8# y) = isTrue# ((word8ToWord# x) `neWord#` (word8ToWord# y)) {-# INLINE [1] eqWord8 #-} {-# INLINE [1] neWord8 #-} @@ -268,8 +268,8 @@ instance Eq Word16 where (/=) = neWord16 eqWord16, neWord16 :: Word16 -> Word16 -> Bool -eqWord16 (W16# x) (W16# y) = isTrue# (x `eqWord16#` y) -neWord16 (W16# x) (W16# y) = isTrue# (x `neWord16#` y) +eqWord16 (W16# x) (W16# y) = isTrue# ((word16ToWord# x) `eqWord#` (word16ToWord# y)) +neWord16 (W16# x) (W16# y) = isTrue# ((word16ToWord# x) `neWord#` (word16ToWord# y)) {-# INLINE [1] eqWord16 #-} {-# INLINE [1] neWord16 #-} @@ -500,8 +500,8 @@ instance Eq Word32 where (/=) = neWord32 eqWord32, neWord32 :: Word32 -> Word32 -> Bool -eqWord32 (W32# x) (W32# y) = isTrue# (x `eqWord32#` y) -neWord32 (W32# x) (W32# y) = isTrue# (x `neWord32#` y) +eqWord32 (W32# x) (W32# y) = isTrue# ((word32ToWord# x) `eqWord#` (word32ToWord# y)) +neWord32 (W32# x) (W32# y) = isTrue# ((word32ToWord# x) `neWord#` (word32ToWord# y)) {-# INLINE [1] eqWord32 #-} {-# INLINE [1] neWord32 #-} ===================================== testsuite/tests/overloadedrecflds/should_run/T11671_run.hs ===================================== @@ -12,8 +12,9 @@ import GHC.Prim (Addr#) instance KnownSymbol symbol => IsLabel symbol String where fromLabel = symbolVal (Proxy :: Proxy symbol) -(#) :: String -> Int -> String +(#), (#.) :: String -> Int -> String (#) _ i = show i +_ #. i = show i f :: Addr# -> Int -> String f _ i = show i @@ -26,13 +27,13 @@ main = traverse_ putStrLn , #type , #Foo , #3 - , #199.4 + , #"199.4" , #17a23b , #f'a' , #'a' , #' , #''notTHSplice - , #... + , #"..." , #привет , #こんにちは , #"3" ===================================== testsuite/tests/printer/Test22771.hs ===================================== @@ -14,8 +14,9 @@ import GHC.Prim (Addr#) instance KnownSymbol symbol => IsLabel symbol String where fromLabel = symbolVal (Proxy :: Proxy symbol) -(#) :: String -> Int -> String +(#), (#.) :: String -> Int -> String (#) _ i = show i +_ #. i = show i f :: Addr# -> Int -> String f _ i = show i @@ -28,13 +29,13 @@ main = traverse_ putStrLn , #type , #Foo , #3 - , #199.4 + , #"199.4" , #17a23b , #f'a' , #'a' , #' , #''notTHSplice - , #... + , #"..." , #привет , #こんにちは , #"3" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/28c5c7d3bbd80090abdaa2a1fbd1421d2b3e5c5f...7b9365d0de5e506ddc9a8cc6ee40c25f36f6485b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/28c5c7d3bbd80090abdaa2a1fbd1421d2b3e5c5f...7b9365d0de5e506ddc9a8cc6ee40c25f36f6485b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 13:28:28 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 07 Feb 2023 08:28:28 -0500 Subject: [Git][ghc/ghc][wip/js-rts-fixmes] JS RTS: use nFieldCache for closureConstructors Message-ID: <63e251fc4b1e0_1108fe56cecbdc14981c2@gitlab.mail> Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC Commits: 95801b53 by Josh Meredith at 2023-02-07T13:28:16+00:00 JS RTS: use nFieldCache for closureConstructors - - - - - 2 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -133,6 +133,7 @@ module GHC.JS.Make , clsName , dataFieldName, dataFieldNames , varName, varNames + , nFieldCache ) where @@ -645,7 +646,7 @@ dataFieldCache :: Array Int FastString dataFieldCache = listArray (0,nFieldCache) (map (mkFastString . ('d':) . show) [(0::Int)..nFieldCache]) nFieldCache :: Int -nFieldCache = 16384 +nFieldCache = 24 dataFieldName :: Int -> FastString dataFieldName i @@ -658,39 +659,39 @@ dataFieldNames = fmap dataFieldName [1..nFieldCache] -- | Cache "h$dXXX" names dataCache :: Array Int FastString -dataCache = listArray (0,63) (map (mkFastString . ("h$d"++) . show) [(0::Int)..63]) +dataCache = listArray (0,nFieldCache) (map (mkFastString . ("h$d"++) . show) [(0::Int)..nFieldCache]) dataName :: Int -> FastString dataName i - | i < 0 || i > 63 = panic "dataCacheName" (ppr i) - | otherwise = dataCache ! i + | i < 0 || i > nFieldCache = panic "dataCacheName" (ppr i) + | otherwise = dataCache ! i allocData :: Int -> JExpr allocData i = toJExpr (TxtI (dataCache ! i)) -- | Cache "h$cXXX" names clsCache :: Array Int FastString -clsCache = listArray (0,63) (map (mkFastString . ("h$c"++) . show) [(0::Int)..63]) +clsCache = listArray (0,nFieldCache) (map (mkFastString . ("h$c"++) . show) [(0::Int)..nFieldCache]) clsName :: Int -> FastString clsName i - | i < 0 || i > 63 = panic "clsCacheName" (ppr i) - | otherwise = clsCache ! i + | i < 0 || i > nFieldCache = panic "clsCacheName" (ppr i) + | otherwise = clsCache ! i allocClsA :: Int -> JExpr allocClsA i = toJExpr (TxtI (clsCache ! i)) -- | Cache "xXXX" names varCache :: Array Int FastString -varCache = listArray (0,63) (map (mkFastString . ('x':) . show) [(0::Int)..63]) +varCache = listArray (0,nFieldCache) (map (mkFastString . ('x':) . show) [(0::Int)..nFieldCache]) varName :: Int -> Ident varName i - | i < 0 || i > 63 = panic "varCacheName" (ppr i) - | otherwise = TxtI $ varCache ! i + | i < 0 || i > nFieldCache = panic "varCacheName" (ppr i) + | otherwise = TxtI $ varCache ! i varNames :: [Ident] -varNames = fmap varName [1..63] +varNames = fmap varName [1..nFieldCache] -------------------------------------------------------------------------------- ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -81,8 +81,8 @@ resetResultVar r = toJExpr r |= null_ -- JIT can optimize better. closureConstructors :: StgToJSConfig -> JStat closureConstructors s = BlockStat - [ mconcat (map mkClosureCon (Nothing : map Just [0..24])) - , mconcat (map mkDataFill [1..24]) + [ mconcat (map mkClosureCon (Nothing : map Just [0..nFieldCache])) + , mconcat (map mkDataFill [1..nFieldCache]) ] where prof = csProf s View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95801b5384f4ee166ca5ceb84cfc905caca5f65e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95801b5384f4ee166ca5ceb84cfc905caca5f65e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 13:49:06 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 07 Feb 2023 08:49:06 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/revert-dont-kee-exit-joins Message-ID: <63e256d260a94_1108fe193a739815206dd@gitlab.mail> Matthew Pickering pushed new branch wip/revert-dont-kee-exit-joins at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/revert-dont-kee-exit-joins You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 13:50:23 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 07 Feb 2023 08:50:23 -0500 Subject: [Git][ghc/ghc][wip/revert-dont-kee-exit-joins] Revert "Don't keep exit join points so much" Message-ID: <63e2571f3eb49_1108fe5ddd5ad815225c0@gitlab.mail> Matthew Pickering pushed to branch wip/revert-dont-kee-exit-joins at Glasgow Haskell Compiler / GHC Commits: 9fda5397 by Matthew Pickering at 2023-02-07T13:49:47+00:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 - - - - - 11 changed files: - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - − testsuite/tests/simplCore/should_compile/T21148.hs - − testsuite/tests/simplCore/should_compile/T21148.stderr - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/stranal/should_compile/T21128.hs - testsuite/tests/stranal/should_compile/T21128.stderr Changes: ===================================== compiler/GHC/Core/Opt/Exitify.hs ===================================== @@ -433,7 +433,6 @@ inlining. Exit join points, recognizable using `isExitJoinId` are join points with an occurrence in a recursive group, and can be recognized (after the occurrence analyzer ran!) using `isExitJoinId`. - This function detects joinpoints with `occ_in_lam (idOccinfo id) == True`, because the lambdas of a non-recursive join point are not considered for `occ_in_lam`. For example, in the following code, `j1` is /not/ marked @@ -447,29 +446,6 @@ To prevent inlining, we check for isExitJoinId * In `simplLetUnfolding` we simply give exit join points no unfolding, which prevents inlining in `postInlineUnconditionally` and call sites. -But see Note [Be selective about not-inlining exit join points] - -Note [Be selective about not-inlining exit join points] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If we follow "do not inline exit join points" mantra throughout, -some bad things happen. - -* We can lose CPR information: see #21148 - -* We get useless clutter (#22084) that - - makes the program bigger (including duplicated code #20739), and - - adds extra jumps (and maybe stack saves) at runtime - -So instead we follow "do not inline exit join points" for a /single run/ -of the simplifier, right after Exitification. That should give a -sufficient chance for used-once things to inline, but subsequent runs -will inline them back in. (Annoyingly, as things stand, only with -O2 -is there a subsequent run, but that might change, and it's not a huge -deal anyway.) - -This is controlled by the Simplifier's sm_keep_exits flag; see -GHC.Core.Opt.Pipeline. - Note [Placement of the exitification pass] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ I (Joachim) experimented with multiple positions for the Exitification pass in ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -15,7 +15,7 @@ import GHC.Driver.Plugins ( withPlugins, installCoreToDos ) import GHC.Driver.Env import GHC.Driver.Config.Core.Lint ( endPass ) import GHC.Driver.Config.Core.Opt.LiberateCase ( initLiberateCaseOpts ) -import GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyOpts, initSimplMode ) +import GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyOpts, initSimplMode, initGentleSimplMode ) import GHC.Driver.Config.Core.Opt.WorkWrap ( initWorkWrapOpts ) import GHC.Driver.Config.Core.Rules ( initRuleOpts ) import GHC.Platform.Ways ( hasWay, Way(WayProf) ) @@ -28,7 +28,6 @@ import GHC.Core.Utils ( dumpIdInfoOfProgram ) import GHC.Core.Lint ( lintAnnots ) import GHC.Core.Lint.Interactive ( interactiveInScope ) import GHC.Core.Opt.Simplify ( simplifyExpr, simplifyPgm ) -import GHC.Core.Opt.Simplify.Env( SimplMode(..) ) import GHC.Core.Opt.Simplify.Monad import GHC.Core.Opt.Monad import GHC.Core.Opt.Pipeline.Types @@ -153,45 +152,32 @@ getCoreToDo dflags hpt_rule_base extra_vars maybe_strictness_before _ = CoreDoNothing - ---------------------------- - base_simpl_mode :: SimplMode - base_simpl_mode = initSimplMode dflags - - -- gentle_mode: make specialiser happy: minimum effort please - -- See Note [Inline in InitialPhase] - -- See Note [RULEs enabled in InitialPhase] - gentle_mode = base_simpl_mode { sm_names = ["Gentle"] - , sm_phase = InitialPhase - , sm_case_case = False } - - simpl_mode phase name - = base_simpl_mode { sm_names = [name], sm_phase = phase } - - keep_exits :: SimplMode -> SimplMode - -- See Note [Be selective about not-inlining exit join points] - -- in GHC.Core.Opt.Exitify - keep_exits mode = mode { sm_keep_exits = True } - - ---------------------------- - run_simplifier mode iter - = CoreDoSimplify $ initSimplifyOpts dflags extra_vars iter mode hpt_rule_base - - simpl_phase phase name iter = CoreDoPasses $ - [ maybe_strictness_before phase - , run_simplifier (simpl_mode phase name) iter - , maybe_rule_check phase ] + simpl_phase phase name iter + = CoreDoPasses + $ [ maybe_strictness_before phase + , CoreDoSimplify $ initSimplifyOpts dflags extra_vars iter + (initSimplMode dflags phase name) hpt_rule_base + , maybe_rule_check phase ] -- Run GHC's internal simplification phase, after all rules have run. -- See Note [Compiler phases] in GHC.Types.Basic - simpl_gently = run_simplifier gentle_mode max_iter - simplify_final name = run_simplifier ( simpl_mode FinalPhase name) max_iter - simpl_keep_exits name = run_simplifier (keep_exits $ simpl_mode FinalPhase name) max_iter + simplify name = simpl_phase FinalPhase name max_iter + + -- initial simplify: mk specialiser happy: minimum effort please + -- See Note [Inline in InitialPhase] + -- See Note [RULEs enabled in InitialPhase] + simpl_gently = CoreDoSimplify $ initSimplifyOpts dflags extra_vars max_iter + (initGentleSimplMode dflags) hpt_rule_base - ---------------------------- dmd_cpr_ww = if ww_on then [CoreDoDemand True,CoreDoCpr,CoreDoWorkerWrapper] else [CoreDoDemand False] -- NB: No CPR! See Note [Don't change boxity without worker/wrapper] + demand_analyser = (CoreDoPasses ( + dmd_cpr_ww ++ + [simplify "post-worker-wrapper"] + )) + -- Static forms are moved to the top level with the FloatOut pass. -- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable. static_ptrs_float_outwards = @@ -281,16 +267,14 @@ getCoreToDo dflags hpt_rule_base extra_vars runWhen call_arity $ CoreDoPasses [ CoreDoCallArity - , simplify_final "post-call-arity" + , simplify "post-call-arity" ], -- Strictness analysis - runWhen strictness $ CoreDoPasses - (dmd_cpr_ww ++ [simplify_final "post-worker-wrapper"]), + runWhen strictness demand_analyser, runWhen exitification CoreDoExitify, -- See Note [Placement of the exitification pass] - -- in GHC.Core.Opt.Exitify runWhen full_laziness $ CoreDoFloatOutwards FloatOutSwitches { @@ -312,17 +296,7 @@ getCoreToDo dflags hpt_rule_base extra_vars runWhen do_float_in CoreDoFloatInwards, - -- Final tidy-up run of the simplifier - simpl_keep_exits "final tidy up", - -- Keep exit join point because this is the first - -- Simplifier run after Exitify. Subsequent runs will - -- re-inline those exit join points; their work is done. - -- See Note [Be selective about not-inlining exit join points] - -- in GHC.Core.Opt.Exitify - -- - -- Annoyingly, we only /have/ a subsequent run with -O2. With - -- plain -O we'll still have those exit join points hanging around. - -- Oh well. + simplify "final", -- Final tidy-up maybe_rule_check FinalPhase, @@ -332,31 +306,31 @@ getCoreToDo dflags hpt_rule_base extra_vars -- Case-liberation for -O2. This should be after -- strictness analysis and the simplification which follows it. runWhen liberate_case $ CoreDoPasses - [ CoreLiberateCase, simplify_final "post-liberate-case" ], + [ CoreLiberateCase, simplify "post-liberate-case" ], -- Run the simplifier after LiberateCase to vastly -- reduce the possibility of shadowing -- Reason: see Note [Shadowing] in GHC.Core.Opt.SpecConstr runWhen spec_constr $ CoreDoPasses - [ CoreDoSpecConstr, simplify_final "post-spec-constr"], + [ CoreDoSpecConstr, simplify "post-spec-constr"], -- See Note [Simplify after SpecConstr] maybe_rule_check FinalPhase, runWhen late_specialise $ CoreDoPasses - [ CoreDoSpecialising, simplify_final "post-late-spec"], + [ CoreDoSpecialising, simplify "post-late-spec"], -- LiberateCase can yield new CSE opportunities because it peels -- off one layer of a recursive function (concretely, I saw this -- in wheel-sieve1), and I'm guessing that SpecConstr can too -- And CSE is a very cheap pass. So it seems worth doing here. runWhen ((liberate_case || spec_constr) && cse) $ CoreDoPasses - [ CoreCSE, simplify_final "post-final-cse" ], + [ CoreCSE, simplify "post-final-cse" ], --------- End of -O2 passes -------------- runWhen late_dmd_anal $ CoreDoPasses ( - dmd_cpr_ww ++ [simplify_final "post-late-ww"] + dmd_cpr_ww ++ [simplify "post-late-ww"] ), -- Final run of the demand_analyser, ensures that one-shot thunks are ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -248,16 +248,13 @@ data SimplMode = SimplMode -- See comments in GHC.Core.Opt.Simplify.Monad , sm_uf_opts :: !UnfoldingOpts -- ^ Unfolding options , sm_case_case :: !Bool -- ^ Whether case-of-case is enabled , sm_pre_inline :: !Bool -- ^ Whether pre-inlining is enabled - , sm_keep_exits :: !Bool -- ^ True <=> keep ExitJoinIds - -- See Note [Do not inline exit join points] - -- in GHC.Core.Opt.Exitify - , sm_float_enable :: !FloatEnable -- ^ Whether to enable floating out + , sm_float_enable :: !FloatEnable -- ^ Whether to enable floating out , sm_do_eta_reduction :: !Bool - , sm_arity_opts :: !ArityOpts - , sm_rule_opts :: !RuleOpts - , sm_case_folding :: !Bool - , sm_case_merge :: !Bool - , sm_co_opt_opts :: !OptCoercionOpts -- ^ Coercion optimiser options + , sm_arity_opts :: !ArityOpts + , sm_rule_opts :: !RuleOpts + , sm_case_folding :: !Bool + , sm_case_merge :: !Bool + , sm_co_opt_opts :: !OptCoercionOpts -- ^ Coercion optimiser options } instance Outputable SimplMode where ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1395,11 +1395,11 @@ preInlineUnconditionally -- Reason: we don't want to inline single uses, or discard dead bindings, -- for unlifted, side-effect-ful bindings preInlineUnconditionally env top_lvl bndr rhs rhs_env - | not pre_inline = Nothing + | not pre_inline_unconditionally = Nothing | not active = Nothing | isTopLevel top_lvl && isDeadEndId bndr = Nothing -- Note [Top-level bottoming Ids] | isCoVar bndr = Nothing -- Note [Do not inline CoVars unconditionally] - | keep_exits, isExitJoinId bndr = Nothing -- Note [Do not inline exit join points] + | isExitJoinId bndr = Nothing -- Note [Do not inline exit join points] -- in module Exitify | not (one_occ (idOccInfo bndr)) = Nothing | not (isStableUnfolding unf) = Just $! (extend_subst_with rhs) @@ -1409,36 +1409,19 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env , Just inl <- maybeUnfoldingTemplate unf = Just $! (extend_subst_with inl) | otherwise = Nothing where - mode = seMode env - phase = sm_phase mode - keep_exits = sm_keep_exits mode - pre_inline = sm_pre_inline mode - unf = idUnfolding bndr extend_subst_with inl_rhs = extendIdSubst env bndr $! (mkContEx rhs_env inl_rhs) one_occ IAmDead = True -- Happens in ((\x.1) v) - one_occ OneOcc{ occ_n_br = 1 , occ_in_lam = NotInsideLam } = isNotTopLevel top_lvl || early_phase - one_occ OneOcc{ occ_n_br = 1 , occ_in_lam = IsInsideLam , occ_int_cxt = IsInteresting } = canInlineInLam rhs + one_occ _ = False - one_occ OneOcc{ occ_n_br = 1 } -- Inline join point that are used once, even inside - | isJoinId bndr = True -- lambdas (which are presumably other join points) - -- E.g. join j x = rhs in - -- joinrec k y = ....j x.... - -- Here j must be an exit for k, and we can safely inline it under the lambda - -- This includes the case where j is nullary: a nullary join point is just the - -- same as an arity-1 one. So we don't look at occ_int_cxt. - -- All of this only applies if keep_exits is False, otherwise the - -- earlier guard on preInlineUnconditionally would have fired - - one_occ _ = False - - active = isActive phase (inlinePragmaActivation inline_prag) + pre_inline_unconditionally = sePreInline env + active = isActive (sePhase env) (inlinePragmaActivation inline_prag) -- See Note [pre/postInlineUnconditionally in gentle mode] inline_prag = idInlinePragma bndr @@ -1470,7 +1453,7 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env -- not ticks. Counting ticks cannot be duplicated, and non-counting -- ticks around a Lam will disappear anyway. - early_phase = phase /= FinalPhase + early_phase = sePhase env /= FinalPhase -- If we don't have this early_phase test, consider -- x = length [1,2,3] -- The full laziness pass carefully floats all the cons cells to ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -1532,10 +1532,8 @@ scExpr' env (Case scrut b ty alts) scrut_occ = case con of DataAlt dc -- See Note [Do not specialise evals] | not (single_alt && all deadArgOcc arg_occs) - -> -- pprTrace "sc_alt1" (ppr b' $$ ppr con $$ ppr bs $$ ppr arg_occs) $ - ScrutOcc (unitUFM dc arg_occs) - _ -> -- pprTrace "sc_alt1" (ppr b' $$ ppr con $$ ppr bs $$ ppr arg_occs) $ - UnkOcc + -> ScrutOcc (unitUFM dc arg_occs) + _ -> UnkOcc ; return (usg', b_occ `combineOcc` scrut_occ, Alt con bs2 rhs') } ===================================== compiler/GHC/Driver/Config/Core/Opt/Simplify.hs ===================================== @@ -2,6 +2,7 @@ module GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyExprOpts , initSimplifyOpts , initSimplMode + , initGentleSimplMode ) where import GHC.Prelude @@ -26,13 +27,12 @@ import GHC.Types.Var ( Var ) initSimplifyExprOpts :: DynFlags -> InteractiveContext -> SimplifyExprOpts initSimplifyExprOpts dflags ic = SimplifyExprOpts { se_fam_inst = snd $ ic_instances ic - - , se_mode = (initSimplMode dflags) { sm_names = ["GHCi"] - , sm_inline = False } - -- sm_inline: do not do any inlining, in case we expose - -- some unboxed tuple stuff that confuses the bytecode + , se_mode = (initSimplMode dflags InitialPhase "GHCi") + { sm_inline = False + -- Do not do any inlining, in case we expose some + -- unboxed tuple stuff that confuses the bytecode -- interpreter - + } , se_top_env_cfg = TopEnvConfig { te_history_size = historySize dflags , te_tick_factor = simplTickFactor dflags @@ -56,25 +56,31 @@ initSimplifyOpts dflags extra_vars iterations mode hpt_rule_base = let } in opts -initSimplMode :: DynFlags -> SimplMode -initSimplMode dflags = SimplMode - { sm_names = ["Unknown simplifier run"] -- Always overriden - , sm_phase = InitialPhase - , sm_rules = gopt Opt_EnableRewriteRules dflags - , sm_eta_expand = gopt Opt_DoLambdaEtaExpansion dflags - , sm_pre_inline = gopt Opt_SimplPreInlining dflags - , sm_do_eta_reduction = gopt Opt_DoEtaReduction dflags - , sm_uf_opts = unfoldingOpts dflags - , sm_float_enable = floatEnable dflags - , sm_arity_opts = initArityOpts dflags - , sm_rule_opts = initRuleOpts dflags - , sm_case_folding = gopt Opt_CaseFolding dflags - , sm_case_merge = gopt Opt_CaseMerge dflags - , sm_co_opt_opts = initOptCoercionOpts dflags +initSimplMode :: DynFlags -> CompilerPhase -> String -> SimplMode +initSimplMode dflags phase name = SimplMode + { sm_names = [name] + , sm_phase = phase + , sm_rules = gopt Opt_EnableRewriteRules dflags + , sm_eta_expand = gopt Opt_DoLambdaEtaExpansion dflags , sm_cast_swizzle = True - , sm_inline = True - , sm_case_case = True - , sm_keep_exits = False + , sm_inline = True + , sm_uf_opts = unfoldingOpts dflags + , sm_case_case = True + , sm_pre_inline = gopt Opt_SimplPreInlining dflags + , sm_float_enable = floatEnable dflags + , sm_do_eta_reduction = gopt Opt_DoEtaReduction dflags + , sm_arity_opts = initArityOpts dflags + , sm_rule_opts = initRuleOpts dflags + , sm_case_folding = gopt Opt_CaseFolding dflags + , sm_case_merge = gopt Opt_CaseMerge dflags + , sm_co_opt_opts = initOptCoercionOpts dflags + } + +initGentleSimplMode :: DynFlags -> SimplMode +initGentleSimplMode dflags = (initSimplMode dflags InitialPhase "Gentle") + { -- Don't do case-of-case transformations. + -- This makes full laziness work better + sm_case_case = False } floatEnable :: DynFlags -> FloatEnable ===================================== testsuite/tests/simplCore/should_compile/T21148.hs deleted ===================================== @@ -1,12 +0,0 @@ -module T211148 where - --- The point of this test is that f should get a (nested) --- CPR property, with a worker of type --- $wf :: Int# -> State# RealWorld -> (# State# RealWorld, Int# #) - -{-# NOINLINE f #-} --- The NOINLINE makes GHC do a worker/wrapper split --- even though f is small -f :: Int -> IO Int -f x = return $! sum [0..x] - ===================================== testsuite/tests/simplCore/should_compile/T21148.stderr deleted ===================================== @@ -1,126 +0,0 @@ - -==================== Tidy Core ==================== -Result size of Tidy Core - = {terms: 73, types: 80, coercions: 6, joins: 2/2} - --- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule4 :: GHC.Prim.Addr# -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] -T211148.$trModule4 = "main"# - --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule3 :: GHC.Types.TrName -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -T211148.$trModule3 = GHC.Types.TrNameS T211148.$trModule4 - --- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule2 :: GHC.Prim.Addr# -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] -T211148.$trModule2 = "T211148"# - --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule1 :: GHC.Types.TrName -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -T211148.$trModule1 = GHC.Types.TrNameS T211148.$trModule2 - --- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule :: GHC.Types.Module -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -T211148.$trModule - = GHC.Types.Module T211148.$trModule3 T211148.$trModule1 - --- RHS size: {terms: 41, types: 35, coercions: 0, joins: 2/2} -T211148.$wf [InlPrag=NOINLINE] - :: GHC.Prim.Int# - -> GHC.Prim.State# GHC.Prim.RealWorld - -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #) -[GblId, Arity=2, Str=, Unf=OtherCon []] -T211148.$wf - = \ (ww_s179 :: GHC.Prim.Int#) - (eta_s17b [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld) -> - case GHC.Prim.># 0# ww_s179 of { - __DEFAULT -> - join { - exit_X0 [Dmd=SC(S,C(1,!P(L,L)))] - :: GHC.Prim.Int# - -> GHC.Prim.Int# - -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #) - [LclId[JoinId(2)(Nothing)], Arity=2, Str=] - exit_X0 (x_s16Z [OS=OneShot] :: GHC.Prim.Int#) - (ww1_s172 [OS=OneShot] :: GHC.Prim.Int#) - = (# eta_s17b, GHC.Prim.+# ww1_s172 x_s16Z #) } in - joinrec { - $wgo3_s175 [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,C(1,!P(L,L)))] - :: GHC.Prim.Int# - -> GHC.Prim.Int# - -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #) - [LclId[JoinId(2)(Nothing)], Arity=2, Str=, Unf=OtherCon []] - $wgo3_s175 (x_s16Z :: GHC.Prim.Int#) (ww1_s172 :: GHC.Prim.Int#) - = case GHC.Prim.==# x_s16Z ww_s179 of { - __DEFAULT -> - jump $wgo3_s175 - (GHC.Prim.+# x_s16Z 1#) (GHC.Prim.+# ww1_s172 x_s16Z); - 1# -> jump exit_X0 x_s16Z ww1_s172 - }; } in - jump $wgo3_s175 0# 0#; - 1# -> (# eta_s17b, 0# #) - } - --- RHS size: {terms: 14, types: 19, coercions: 0, joins: 0/0} -T211148.f1 [InlPrag=NOINLINE[final]] - :: Int - -> GHC.Prim.State# GHC.Prim.RealWorld - -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #) -[GblId, - Arity=2, - Str=<1!P(L)>, - Cpr=1(, 1), - Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (x_s177 [Occ=Once1!] :: Int) - (eta_s17b [Occ=Once1, OS=OneShot] - :: GHC.Prim.State# GHC.Prim.RealWorld) -> - case x_s177 of { GHC.Types.I# ww_s179 [Occ=Once1] -> - case T211148.$wf ww_s179 eta_s17b of - { (# ww1_s17e [Occ=Once1], ww2_s17j [Occ=Once1] #) -> - (# ww1_s17e, GHC.Types.I# ww2_s17j #) - } - }}] -T211148.f1 - = \ (x_s177 :: Int) - (eta_s17b [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld) -> - case x_s177 of { GHC.Types.I# ww_s179 -> - case T211148.$wf ww_s179 eta_s17b of { (# ww1_s17e, ww2_s17j #) -> - (# ww1_s17e, GHC.Types.I# ww2_s17j #) - } - } - --- RHS size: {terms: 1, types: 0, coercions: 6, joins: 0/0} -f [InlPrag=NOINLINE[final]] :: Int -> IO Int -[GblId, - Arity=2, - Str=<1!P(L)>, - Cpr=1(, 1), - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}] -f = T211148.f1 - `cast` (_R %<'Many>_N ->_R Sym (GHC.Types.N:IO[0] _R) - :: (Int - -> GHC.Prim.State# GHC.Prim.RealWorld - -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)) - ~R# (Int -> IO Int)) - - - ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -429,7 +429,6 @@ test('T21763a', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) test('T22028', normal, compile, ['-O -ddump-rule-firings']) test('T22114', normal, compile, ['-O']) test('T21286', normal, multimod_compile, ['T21286', '-O -ddump-rule-firings']) -test('T21148', [grep_errmsg(r'Cpr=') ], compile, ['-O -ddump-simpl']) # One module, T21851.hs, has OPTIONS_GHC -ddump-simpl test('T21851', [grep_errmsg(r'case.*w\$sf') ], multimod_compile, ['T21851', '-O -dno-typeable-binds -dsuppress-uniques']) ===================================== testsuite/tests/stranal/should_compile/T21128.hs ===================================== @@ -2,10 +2,6 @@ module T21128 where import T21128a -{- This test originally had some unnecessary reboxing of y -in the hot path of $wtheresCrud. That reboxing should -not happen. -} - theresCrud :: Int -> Int -> Int theresCrud x y = go x where @@ -13,4 +9,3 @@ theresCrud x y = go x go 1 = index x y 1 go n = go (n-1) {-# NOINLINE theresCrud #-} - ===================================== testsuite/tests/stranal/should_compile/T21128.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 125, types: 68, coercions: 4, joins: 0/0} + = {terms: 137, types: 92, coercions: 4, joins: 0/0} lvl = "error"# @@ -29,11 +29,17 @@ lvl9 = SrcLoc lvl2 lvl3 lvl5 lvl6 lvl7 lvl6 lvl8 lvl10 = PushCallStack lvl1 lvl9 EmptyCallStack +$windexError + = \ @a @b ww eta eta1 eta2 -> + error + (lvl10 `cast` :: CallStack ~R# (?callStack::CallStack)) + (++ (ww eta) (++ (ww eta1) (ww eta2))) + indexError = \ @a @b $dShow eta eta1 eta2 -> - error - (lvl10 `cast` :: ...) - (++ (show $dShow eta) (++ (show $dShow eta1) (show $dShow eta2))) + case $dShow of { C:Show ww ww1 ww2 -> + $windexError ww1 eta eta1 eta2 + } $trModule3 = TrNameS $trModule4 @@ -42,7 +48,8 @@ $trModule1 = TrNameS $trModule2 $trModule = Module $trModule3 $trModule1 $wlvl - = \ ww ww1 ww2 -> indexError $fShowInt (I# ww2) (I# ww1) (I# ww) + = \ ww ww1 ww2 -> + $windexError $fShowInt_$cshow (I# ww2) (I# ww1) (I# ww) index = \ l u i -> @@ -66,7 +73,7 @@ index ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 108, types: 46, coercions: 0, joins: 3/3} + = {terms: 108, types: 47, coercions: 0, joins: 3/4} $trModule4 = "main"# @@ -82,34 +89,35 @@ i = I# 1# l = I# 0# -lvl = \ x ww -> indexError $fShowInt x (I# ww) i +lvl = \ y -> $windexError $fShowInt_$cshow l y l -lvl1 = \ ww -> indexError $fShowInt l (I# ww) l +lvl1 = \ ww y -> $windexError $fShowInt_$cshow (I# ww) y i $wtheresCrud = \ ww ww1 -> + let { y = I# ww1 } in join { - exit - = case <# 0# ww1 of { - __DEFAULT -> case lvl1 ww1 of wild { }; - 1# -> 0# - } } in - join { - exit1 + lvl2 = case <=# ww 1# of { - __DEFAULT -> case lvl (I# ww) ww1 of wild { }; + __DEFAULT -> case lvl1 ww y of wild { }; 1# -> case <# 1# ww1 of { - __DEFAULT -> case lvl (I# ww) ww1 of wild { }; + __DEFAULT -> case lvl1 ww y of wild { }; 1# -> -# 1# ww } } } in + join { + lvl3 + = case <# 0# ww1 of { + __DEFAULT -> case lvl y of wild { }; + 1# -> 0# + } } in joinrec { $wgo ww2 = case ww2 of wild { __DEFAULT -> jump $wgo (-# wild 1#); - 0# -> jump exit; - 1# -> jump exit1 + 0# -> jump lvl3; + 1# -> jump lvl2 }; } in jump $wgo ww View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9fda5397e144fafa37bdfc130cd340a75de0fe3a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9fda5397e144fafa37bdfc130cd340a75de0fe3a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 14:02:29 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 07 Feb 2023 09:02:29 -0500 Subject: [Git][ghc/ghc][wip/T22264-9.2] 19 commits: Allow stat increases for GHC 9.2 Message-ID: <63e259f5c61e8_1108fec035f0153143a@gitlab.mail> Ben Gamari pushed to branch wip/T22264-9.2 at Glasgow Haskell Compiler / GHC Commits: 51138891 by Zubin Duggal at 2023-02-06T19:20:23-05:00 Allow stat increases for GHC 9.2 Metric Increase: T13701 T14697 - - - - - bf806f27 by Ben Gamari at 2023-02-06T19:35:43-05:00 rts: Introduce getNumCapabilities And ensure accesses to n_capabilities are atomic (although with relaxed ordering). This is necessary as RTS API callers may concurrently call into the RTS without holding a capability. (cherry picked from commit 70999283156f527c5aea6dee57a3d14989a9903a) - - - - - 4579f239 by Ben Gamari at 2023-02-06T19:35:43-05:00 nonmoving: Don't show occupancy if we didn't collect live words (cherry picked from commit fcd9794163f6ae7af8783676ee79e0b8e78167ba) - - - - - 4e1cdb3b by Ben Gamari at 2023-02-06T19:57:03-05:00 nonmoving: Refactor update remembered set initialization This avoids a lock inversion between the storage manager mutex and the stable pointer table mutex by not dropping the SM_MUTEX in nonmovingCollect. This requires quite a bit of rejiggering but it does seem like a better strategy. (cherry picked from commit 543cae0084a72ca767a443d857f9e65a5a79f71d) - - - - - 4e07623e by Ben Gamari at 2023-02-06T19:57:06-05:00 nonmoving: Fix style (cherry picked from commit b642ef1dc4cbe19c3479b2c014e7d1f7959f8e4a) - - - - - 46b28d57 by Ben Gamari at 2023-02-06T19:57:06-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Likely fixes the cause of #22264. (cherry picked from commit f8988a9c53ae73ff5b9c6008f467a7171e99c61f) - - - - - af8632a4 by Ben Gamari at 2023-02-06T20:16:41-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. (cherry picked from commit a999f7b5b4b7316c088d7233a452fb33dc17646f) - - - - - 00628207 by Ben Gamari at 2023-02-06T20:16:43-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. (cherry picked from commit 48b89dba91640fa977d038ea5283019c73f1b18e) - - - - - 8c953295 by Ben Gamari at 2023-02-06T20:16:43-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive (cherry picked from commit 36ca160d0f199a688cf5fbc91d4bb92d2d4ea14e) - - - - - 19019c9d by Ben Gamari at 2023-02-06T20:16:43-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. (cherry picked from commit 8b64aff0fa978c762dfae8df235dd2b2a340656a) - - - - - 2d1c56ba by Ben Gamari at 2023-02-06T20:16:43-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. (cherry picked from commit dde67d6e32ecff0e400f98213d42ae790babac09) - - - - - 0d308632 by Ben Gamari at 2023-02-06T20:16:43-05:00 nonmoving: Don't push if nonmoving collector isn't enabled (cherry picked from commit 8adc1750c02e596b4014d2837b4eb3d76bd130f2) - - - - - 37c514cb by Ben Gamari at 2023-02-06T20:16:43-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. (cherry picked from commit c620669651c52fd228af61040747dd7236c4ba2b) - - - - - a6eb1cca by Ben Gamari at 2023-02-06T20:16:43-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys (cherry picked from commit 3887132fcd20f0a1edfc9f7006bdbed2634e2a8d) - - - - - e765db6e by Ben Gamari at 2023-02-06T20:16:43-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. (cherry picked from commit cc75031b4d93d4565e0428cb5910d9b9a645485b) - - - - - a877b0e0 by Ben Gamari at 2023-02-06T20:16:43-05:00 nonmoving: Add missing no-op in busy-wait loop (cherry picked from commit 9f931a8801c84b8ae473f91349e144eebc73b415) - - - - - b8a8614c by Ben Gamari at 2023-02-06T20:18:47-05:00 nonmoving: Move current segment array into Capability (cherry picked from commit 9d245c1baec91ee79d715062b127e487456d9c9e) - - - - - b5a78549 by Ben Gamari at 2023-02-06T20:18:47-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. (cherry picked from commit 6bdce35cdd59112a8cb4a4a3b061e854ada3ff63) - - - - - 18d6ad8a by Ben Gamari at 2023-02-06T20:18:47-05:00 nonmoving: Fix unregisterised build (cherry picked from commit 6df2709e7215ea80d7267800e0318aee2a7c277f) - - - - - 30 changed files: - includes/rts/Threads.h - rts/Capability.c - rts/Capability.h - rts/Messages.h - rts/PrimOps.cmm - rts/Printer.c - rts/ProfHeap.c - rts/ProfilerReport.c - rts/ProfilerReportJson.c - rts/Profiling.c - rts/Proftimer.c - rts/RetainerProfile.c - rts/RtsAPI.c - rts/RtsStartup.c - rts/SMPClosureOps.h - rts/STM.c - rts/Schedule.c - rts/Stats.c - rts/Task.c - rts/Threads.c - rts/TraverseHeap.c - rts/eventlog/EventLog.c - rts/hooks/LongGCSync.c - rts/posix/Signals.c - rts/sm/Compact.c - rts/sm/Evac.c - rts/sm/GC.c - rts/sm/MarkWeak.c - rts/sm/NonMoving.c - rts/sm/NonMoving.h The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c461f51017d9d4ae1842a8455ebf05ab71ee9b16...18d6ad8a51b4fdc740934f8260fb4b4e4ab825e5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c461f51017d9d4ae1842a8455ebf05ab71ee9b16...18d6ad8a51b4fdc740934f8260fb4b4e4ab825e5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 14:39:32 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 07 Feb 2023 09:39:32 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/mr-template Message-ID: <63e262a426409_1108fe6d96a63c1539361@gitlab.mail> Ben Gamari pushed new branch wip/mr-template at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/mr-template You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 15:02:22 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 07 Feb 2023 10:02:22 -0500 Subject: [Git][ghc/ghc][wip/js-rts-fixmes] JS RTS: use jsClosureCount for closureConstructors and cache sizes Message-ID: <63e267fef70b_1108fe71da71381549481@gitlab.mail> Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC Commits: 57d92222 by Josh Meredith at 2023-02-07T15:01:48+00:00 JS RTS: use jsClosureCount for closureConstructors and cache sizes - - - - - 2 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -133,6 +133,7 @@ module GHC.JS.Make , clsName , dataFieldName, dataFieldNames , varName, varNames + , jsClosureCount ) where @@ -642,10 +643,13 @@ instance Fractional JExpr where -- | Cache "dXXX" field names dataFieldCache :: Array Int FastString -dataFieldCache = listArray (0,nFieldCache) (map (mkFastString . ('d':) . show) [(0::Int)..nFieldCache]) +dataFieldCache = listArray (0,jsClosureCount) (map (mkFastString . ('d':) . show) [(0::Int)..nFieldCache]) nFieldCache :: Int -nFieldCache = 16384 +nFieldCache = 128 + +jsClosureCount :: Int +jsClosureCount = 24 dataFieldName :: Int -> FastString dataFieldName i @@ -653,44 +657,44 @@ dataFieldName i | otherwise = dataFieldCache ! i dataFieldNames :: [FastString] -dataFieldNames = fmap dataFieldName [1..nFieldCache] +dataFieldNames = fmap dataFieldName [1..jsClosureCount] -- | Cache "h$dXXX" names dataCache :: Array Int FastString -dataCache = listArray (0,63) (map (mkFastString . ("h$d"++) . show) [(0::Int)..63]) +dataCache = listArray (0,jsClosureCount) (map (mkFastString . ("h$d"++) . show) [(0::Int)..jsClosureCount]) dataName :: Int -> FastString dataName i - | i < 0 || i > 63 = panic "dataCacheName" (ppr i) - | otherwise = dataCache ! i + | i < 0 || i > jsClosureCount = panic "dataCacheName" (ppr i) + | otherwise = dataCache ! i allocData :: Int -> JExpr allocData i = toJExpr (TxtI (dataCache ! i)) -- | Cache "h$cXXX" names clsCache :: Array Int FastString -clsCache = listArray (0,63) (map (mkFastString . ("h$c"++) . show) [(0::Int)..63]) +clsCache = listArray (0,jsClosureCount) (map (mkFastString . ("h$c"++) . show) [(0::Int)..jsClosureCount]) clsName :: Int -> FastString clsName i - | i < 0 || i > 63 = panic "clsCacheName" (ppr i) - | otherwise = clsCache ! i + | i < 0 || i > jsClosureCount = panic "clsCacheName" (ppr i) + | otherwise = clsCache ! i allocClsA :: Int -> JExpr allocClsA i = toJExpr (TxtI (clsCache ! i)) -- | Cache "xXXX" names varCache :: Array Int FastString -varCache = listArray (0,63) (map (mkFastString . ('x':) . show) [(0::Int)..63]) +varCache = listArray (0,jsClosureCount) (map (mkFastString . ('x':) . show) [(0::Int)..jsClosureCount]) varName :: Int -> Ident varName i - | i < 0 || i > 63 = panic "varCacheName" (ppr i) - | otherwise = TxtI $ varCache ! i + | i < 0 || i > jsClosureCount = panic "varCacheName" (ppr i) + | otherwise = TxtI $ varCache ! i varNames :: [Ident] -varNames = fmap varName [1..63] +varNames = fmap varName [1..jsClosureCount] -------------------------------------------------------------------------------- ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -81,8 +81,8 @@ resetResultVar r = toJExpr r |= null_ -- JIT can optimize better. closureConstructors :: StgToJSConfig -> JStat closureConstructors s = BlockStat - [ mconcat (map mkClosureCon (Nothing : map Just [0..24])) - , mconcat (map mkDataFill [1..24]) + [ mconcat (map mkClosureCon (Nothing : map Just [0..jsClosureCount])) + , mconcat (map mkDataFill [1..jsClosureCount]) ] where prof = csProf s View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/57d92222eaa97ee7d1da502cd2b94525d10001db -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/57d92222eaa97ee7d1da502cd2b94525d10001db You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 15:52:02 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 07 Feb 2023 10:52:02 -0500 Subject: [Git][ghc/ghc][master] Don't allow . in overloaded labels Message-ID: <63e273a2555ba_1108fe5ddd5ad816032ba@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 4 changed files: - compiler/GHC/Parser/Lexer.x - docs/users_guide/9.6.1-notes.rst - testsuite/tests/overloadedrecflds/should_run/T11671_run.hs - testsuite/tests/printer/Test22771.hs Changes: ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -163,7 +163,6 @@ $small = [$ascsmall $unismall \_] $uniidchar = \x07 -- Trick Alex into handling Unicode. See Note [Unicode in Alex]. $idchar = [$small $large $digit $uniidchar \'] -$labelchar = [$small $large $digit $uniidchar \' \.] $unigraphic = \x06 -- Trick Alex into handling Unicode. See Note [Unicode in Alex]. $graphic = [$small $large $symbol $digit $idchar $special $unigraphic \"\'] @@ -455,7 +454,7 @@ $unigraphic / { isSmartQuote } { smart_quote_error } } <0> { - "#" $labelchar+ / { ifExtension OverloadedLabelsBit } { skip_one_varid_src ITlabelvarid } + "#" $idchar+ / { ifExtension OverloadedLabelsBit } { skip_one_varid_src ITlabelvarid } "#" \" / { ifExtension OverloadedLabelsBit } { lex_quoted_label } } ===================================== docs/users_guide/9.6.1-notes.rst ===================================== @@ -84,7 +84,7 @@ Language This extends the variety syntax for constructing labels under :extension:`OverloadedLabels`. Examples of newly allowed syntax: - Leading capital letters: `#Foo` equivalant to `getLabel @"Foo"` - - Numeric characters: `#3.14` equivalent to `getLabel @"3.14"` + - Numeric characters: `#1728` equivalent to `getLabel @"1728"` - Arbitrary strings: `#"Hello, World!"` equivalent to `getLabel @"Hello, World!"` Compiler ===================================== testsuite/tests/overloadedrecflds/should_run/T11671_run.hs ===================================== @@ -12,8 +12,9 @@ import GHC.Prim (Addr#) instance KnownSymbol symbol => IsLabel symbol String where fromLabel = symbolVal (Proxy :: Proxy symbol) -(#) :: String -> Int -> String +(#), (#.) :: String -> Int -> String (#) _ i = show i +_ #. i = show i f :: Addr# -> Int -> String f _ i = show i @@ -26,13 +27,13 @@ main = traverse_ putStrLn , #type , #Foo , #3 - , #199.4 + , #"199.4" , #17a23b , #f'a' , #'a' , #' , #''notTHSplice - , #... + , #"..." , #привет , #こんにちは , #"3" ===================================== testsuite/tests/printer/Test22771.hs ===================================== @@ -14,8 +14,9 @@ import GHC.Prim (Addr#) instance KnownSymbol symbol => IsLabel symbol String where fromLabel = symbolVal (Proxy :: Proxy symbol) -(#) :: String -> Int -> String +(#), (#.) :: String -> Int -> String (#) _ i = show i +_ #. i = show i f :: Addr# -> Int -> String f _ i = show i @@ -28,13 +29,13 @@ main = traverse_ putStrLn , #type , #Foo , #3 - , #199.4 + , #"199.4" , #17a23b , #f'a' , #'a' , #' , #''notTHSplice - , #... + , #"..." , #привет , #こんにちは , #"3" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b17fb3d96bd2e9f3bf96392f3b3b3e0aed7fe276 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b17fb3d96bd2e9f3bf96392f3b3b3e0aed7fe276 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 15:52:31 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 07 Feb 2023 10:52:31 -0500 Subject: [Git][ghc/ghc][master] Update kinds in comments in GHC.Core.TyCon Message-ID: <63e273bf594b2_1108fe772633e81606773@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 1 changed file: - compiler/GHC/Core/TyCon.hs Changes: ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -194,7 +194,7 @@ Note [Type synonym families] * Type synonym families, also known as "type functions", map directly onto the type functions in FC: - type family F a :: * + type family F a :: Type type instance F Int = Bool ..etc... @@ -210,11 +210,11 @@ Note [Type synonym families] type instance F (F Int) = ... -- BAD! * Translation of type family decl: - type family F a :: * + type family F a :: Type translates to a FamilyTyCon 'F', whose FamTyConFlav is OpenSynFamilyTyCon - type family G a :: * where + type family G a :: Type where G Int = Bool G Bool = Char G a = () @@ -229,7 +229,7 @@ Note [Data type families] See also Note [Wrappers for data instance tycons] in GHC.Types.Id.Make * Data type families are declared thus - data family T a :: * + data family T a :: Type data instance T Int = T1 | T2 Bool Here T is the "family TyCon". @@ -321,7 +321,7 @@ See also Note [Wrappers for data instance tycons] in GHC.Types.Id.Make should not think of a data family T as a *type function* at all, not even an injective one! We can't allow even injective type functions on the LHS of a type function: - type family injective G a :: * + type family injective G a :: Type type instance F (G Int) = Bool is no good, even if G is injective, because consider type instance G Int = Bool @@ -572,21 +572,21 @@ Since they are user-callable we must get their type-argument visibility information right; and that info is in the TyConBinders. Here is an example: - data App a b = MkApp (a b) -- App :: forall {k}. (k->*) -> k -> * + data App a b = MkApp (a b) -- App :: forall {k}. (k->Type) -> k -> Type The TyCon has - tyConTyBinders = [ Named (Bndr (k :: *) Inferred), Anon (k->*), Anon k ] + tyConTyBinders = [ Named (Bndr (k :: Type) Inferred), Anon (k->Type), Anon k ] The TyConBinders for App line up with App's kind, given above. But the DataCon MkApp has the type - MkApp :: forall {k} (a:k->*) (b:k). a b -> App k a b + MkApp :: forall {k} (a:k->Type) (b:k). a b -> App k a b That is, its ForAllTyBinders should be - dataConUnivTyVarBinders = [ Bndr (k:*) Inferred - , Bndr (a:k->*) Specified + dataConUnivTyVarBinders = [ Bndr (k:Type) Inferred + , Bndr (a:k->Type) Specified , Bndr (b:k) Specified ] So tyConTyVarBinders converts TyCon's TyConBinders into TyVarBinders: @@ -620,8 +620,8 @@ They fit together like so: type App a (b :: k) = a b - tyConBinders = [ Bndr (k::*) (NamedTCB Inferred) - , Bndr (a:k->*) AnonTCB + tyConBinders = [ Bndr (k::Type) (NamedTCB Inferred) + , Bndr (a:k->Type) AnonTCB , Bndr (b:k) AnonTCB ] Note that there are three binders here, including the @@ -636,13 +636,13 @@ They fit together like so: that TyVar may scope over some other part of the TyCon's definition. Eg type T a = a -> a we have - tyConBinders = [ Bndr (a:*) AnonTCB ] + tyConBinders = [ Bndr (a:Type) AnonTCB ] synTcRhs = a -> a So the 'a' scopes over the synTcRhs * From the tyConBinders and tyConResKind we can get the tyConKind E.g for our App example: - App :: forall k. (k->*) -> k -> * + App :: forall k. (k->Type) -> k -> Type We get a 'forall' in the kind for each NamedTCB, and an arrow for each AnonTCB @@ -725,15 +725,15 @@ instance Binary TyConBndrVis where -- things such as: -- -- 1) Data declarations: @data Foo = ...@ creates the @Foo@ type constructor of --- kind @*@ +-- kind @Type@ -- -- 2) Type synonyms: @type Foo = ...@ creates the @Foo@ type constructor -- -- 3) Newtypes: @newtype Foo a = MkFoo ...@ creates the @Foo@ type constructor --- of kind @* -> *@ +-- of kind @Type -> Type@ -- -- 4) Class declarations: @class Foo where@ creates the @Foo@ type constructor --- of kind @*@ +-- of kind @Constraint@ -- -- This data type also encodes a number of primitive, built in type constructors -- such as those for function and tuple types. @@ -1252,16 +1252,16 @@ data FamTyConFlav -- -- These are introduced by either a top level declaration: -- - -- > data family T a :: * + -- > data family T a :: Type -- -- Or an associated data type declaration, within a class declaration: -- -- > class C a b where - -- > data T b :: * + -- > data T b :: Type DataFamilyTyCon TyConRepName - -- | An open type synonym family e.g. @type family F x y :: * -> *@ + -- | An open type synonym family e.g. @type family F x y :: Type -> Type@ | OpenSynFamilyTyCon -- | A closed type synonym family e.g. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5dce04ee039ff24c403ac451d920b1eb22488505 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5dce04ee039ff24c403ac451d920b1eb22488505 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 15:53:58 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 07 Feb 2023 10:53:58 -0500 Subject: [Git][ghc/ghc][master] Revert "Use fix-sized equality primops for fixed size boxed types" Message-ID: <63e27416d05a5_1108fe5265c1616581@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - 2 changed files: - libraries/base/GHC/Int.hs - libraries/base/GHC/Word.hs Changes: ===================================== libraries/base/GHC/Int.hs ===================================== @@ -69,8 +69,8 @@ instance Eq Int8 where (/=) = neInt8 eqInt8, neInt8 :: Int8 -> Int8 -> Bool -eqInt8 (I8# x) (I8# y) = isTrue# (x `eqInt8#` y) -neInt8 (I8# x) (I8# y) = isTrue# (x `neInt8#` y) +eqInt8 (I8# x) (I8# y) = isTrue# ((int8ToInt# x) ==# (int8ToInt# y)) +neInt8 (I8# x) (I8# y) = isTrue# ((int8ToInt# x) /=# (int8ToInt# y)) {-# INLINE [1] eqInt8 #-} {-# INLINE [1] neInt8 #-} @@ -280,8 +280,8 @@ instance Eq Int16 where (/=) = neInt16 eqInt16, neInt16 :: Int16 -> Int16 -> Bool -eqInt16 (I16# x) (I16# y) = isTrue# (x `eqInt16#` y) -neInt16 (I16# x) (I16# y) = isTrue# (x `neInt16#` y) +eqInt16 (I16# x) (I16# y) = isTrue# ((int16ToInt# x) ==# (int16ToInt# y)) +neInt16 (I16# x) (I16# y) = isTrue# ((int16ToInt# x) /=# (int16ToInt# y)) {-# INLINE [1] eqInt16 #-} {-# INLINE [1] neInt16 #-} @@ -488,8 +488,8 @@ instance Eq Int32 where (/=) = neInt32 eqInt32, neInt32 :: Int32 -> Int32 -> Bool -eqInt32 (I32# x) (I32# y) = isTrue# (x `eqInt32#` y) -neInt32 (I32# x) (I32# y) = isTrue# (x `neInt32#` y) +eqInt32 (I32# x) (I32# y) = isTrue# ((int32ToInt# x) ==# (int32ToInt# y)) +neInt32 (I32# x) (I32# y) = isTrue# ((int32ToInt# x) /=# (int32ToInt# y)) {-# INLINE [1] eqInt32 #-} {-# INLINE [1] neInt32 #-} ===================================== libraries/base/GHC/Word.hs ===================================== @@ -78,8 +78,8 @@ instance Eq Word8 where (/=) = neWord8 eqWord8, neWord8 :: Word8 -> Word8 -> Bool -eqWord8 (W8# x) (W8# y) = isTrue# (x `eqWord8#` y) -neWord8 (W8# x) (W8# y) = isTrue# (x `neWord8#` y) +eqWord8 (W8# x) (W8# y) = isTrue# ((word8ToWord# x) `eqWord#` (word8ToWord# y)) +neWord8 (W8# x) (W8# y) = isTrue# ((word8ToWord# x) `neWord#` (word8ToWord# y)) {-# INLINE [1] eqWord8 #-} {-# INLINE [1] neWord8 #-} @@ -268,8 +268,8 @@ instance Eq Word16 where (/=) = neWord16 eqWord16, neWord16 :: Word16 -> Word16 -> Bool -eqWord16 (W16# x) (W16# y) = isTrue# (x `eqWord16#` y) -neWord16 (W16# x) (W16# y) = isTrue# (x `neWord16#` y) +eqWord16 (W16# x) (W16# y) = isTrue# ((word16ToWord# x) `eqWord#` (word16ToWord# y)) +neWord16 (W16# x) (W16# y) = isTrue# ((word16ToWord# x) `neWord#` (word16ToWord# y)) {-# INLINE [1] eqWord16 #-} {-# INLINE [1] neWord16 #-} @@ -500,8 +500,8 @@ instance Eq Word32 where (/=) = neWord32 eqWord32, neWord32 :: Word32 -> Word32 -> Bool -eqWord32 (W32# x) (W32# y) = isTrue# (x `eqWord32#` y) -neWord32 (W32# x) (W32# y) = isTrue# (x `neWord32#` y) +eqWord32 (W32# x) (W32# y) = isTrue# ((word32ToWord# x) `eqWord#` (word32ToWord# y)) +neWord32 (W32# x) (W32# y) = isTrue# ((word32ToWord# x) `neWord#` (word32ToWord# y)) {-# INLINE [1] eqWord32 #-} {-# INLINE [1] neWord32 #-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/929161943f19e1673288adc83d165ddc99865798 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/929161943f19e1673288adc83d165ddc99865798 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 17:16:54 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Tue, 07 Feb 2023 12:16:54 -0500 Subject: [Git][ghc/ghc][wip/9.2.6-backports] 2 commits: Bump version to GHC 9.2.6 and add changelog entries Message-ID: <63e28786be829_1108fe5ddd5ad817251a6@gitlab.mail> Zubin pushed to branch wip/9.2.6-backports at Glasgow Haskell Compiler / GHC Commits: d966ed64 by Zubin Duggal at 2023-02-07T22:42:03+05:30 Bump version to GHC 9.2.6 and add changelog entries - - - - - 6ba46427 by Zubin Duggal at 2023-02-07T22:42:17+05:30 Allow metric changes for 9.2.6 as baseline is from a release pipeline Metric Decrease: haddock.base haddock.Cabal haddock.compiler Metric Increase: ManyAlternatives ManyConstructors T10421 T10858 T12227 T12425 T12707 T13035 T13253 T13719 T15164 T16577 T18304 T18698a T18698b T3294 T5321FD T5642 T9203 T9233 T9630 T9872a T9872b T9872c T9872d - - - - - 4 changed files: - configure.ac - docs/users_guide/9.2.1-notes.rst - + docs/users_guide/9.2.6-notes.rst - docs/users_guide/release-notes.rst Changes: ===================================== configure.ac ===================================== @@ -13,7 +13,7 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.2.5], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.2.6], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Version on HEAD must be X.Y (not X.Y.Z) for ProjectVersionMunged variable # to be useful (cf #19058) ===================================== docs/users_guide/9.2.1-notes.rst ===================================== @@ -45,6 +45,19 @@ Language .. _Unlifted Datatypes Proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0265-unlifted-datatypes.rst +* GHC now supports visible type applications in patterns when :extension:`TypeApplications` is enabled . This allows + you to use the ``@variable`` syntax to bind types in patterns. For instance, instead of :: + + foo (Just (x :: ty)) = … + + You can now use + + foo (Just @ty x) = … + + See the `Type Applications in Patterns Proposal`_ for more details + +.. _Type Applications in Patterns Proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0126-type-applications-in-patterns.rst + * Kind inference for data/newtype instance declarations is slightly more restrictive than before. In particular, GHC now requires that the kind of a data family instance be fully determined by the header of the instance, without looking at the definition of the constructor. ===================================== docs/users_guide/9.2.6-notes.rst ===================================== @@ -0,0 +1,128 @@ +.. _release-9-2-6: + +Version 9.2.6 +============== + +The significant changes to the various parts of the compiler are listed in the +following sections. + +The :ghc-flag:`LLVM backend <-fllvm>` of this release is to be used with LLVM +9, 10, 11, or 12. + +Compiler +-------- + +- Fix a regression in the simplifier due to a bad backport in GHC 9.2.5 that + could seriously impact runtime performance when compiling with optimisations + due to duplication of expensive work (:ghc-ticket:`22425`). + +- Fix a compiler panic in the simplifier due to a bad backport in GHC 9.2.5 + (:ghc-ticket:`22491`). + +- Fix a compiler panic in the simplifier that manifests when compiling with + optimisations (:ghc-ticket:`19824`,:ghc-ticket:`22482`). + +- Fix a compiler panic in the demand analyser due to a bug involving shadowing + (:ghc-ticket:`22718`). + +- Fix a compiler panic during the "Float In" optimsation pass due to improper + handling of shadowing (:ghc-ticket:`22662`). + +- Fix a compiler panic in the demand analyser (:ghc-ticket:`22039`). + +- Fix a shadowing related bug in the occurence analysis phase of the simplifier + (:ghc-ticket:`22623`). + +- Fix a compiler bug where programs using Template Haskell involving Constant + Applicative forms could be garbage collected too early (:ghc-ticket:`22417`). + +- Fix a regression in the typechecker where certain typeclass instances + involving type and data familes would fail to resolve (:ghc-ticket:`22647`). + +- Fix the linker warning about chained fixups on Darwin platforms for programs + compiled with GHC (:ghc-ticket:`22429`). + +- Fix a bug with the graph-colouring register allocater leading to compiler + panics when compiling with ``-fregs-graph`` (:ghc-ticket:`22798`). + +- Fix a parser bug where certain keywords which could be used as variables + were not allowed to be used with :extension:`OverloadedRecordDot` + (:ghc-ticket:`20723`). + +- Fix the location of some ``Typeable`` definitions from ``GHC.Types`` which + resulted in poor error messages (:ghc-ticket:`22510`). + +- Improve error messages involving non-exhaustive patterns when using + :extension:`ApplicativeDo` (:ghc-ticket:`22483`). + +- Fix a driver bug where certain non-fatal Safe Haskell related warnings were + being marked as fatal (:ghc-ticket:`22728`). + +Runtime system +-------------- + +- Fix a GC bug where a race condition in the parallel GC could cause it to + garbage collect live sparks (:ghc-ticket:`22528`). + +- Truncate eventlog events with a large payload (:ghc-ticket:`20221`). + +Build system and packaging +-------------------------- + +- Bump ``gmp-tarballs`` to a version which doesn't use the reserved ``x18`` + register on AArch64/Darwin systems, and also has fixes for CVE-2021-43618 + (:ghc-ticket:`22497`, :ghc-ticket:`22789`). + +- Include haddock documentation in interface files for hadrian generated + bindists, including darwin platforms (:ghc-ticket:`22734`). + +Core libraries +-------------- + +- Bump ``bytestring`` to 0.11.4.0. + +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/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 + + ===================================== docs/users_guide/release-notes.rst ===================================== @@ -9,3 +9,4 @@ Release notes 9.2.3-notes 9.2.4-notes 9.2.5-notes + 9.2.6-notes View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b54f4cd66d8c5d2983e6570d82c85674fe6b3c9...6ba4642778d99788f9a329c35c0bc734696c4811 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b54f4cd66d8c5d2983e6570d82c85674fe6b3c9...6ba4642778d99788f9a329c35c0bc734696c4811 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 17:25:02 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 07 Feb 2023 12:25:02 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Don't allow . in overloaded labels Message-ID: <63e2896ea277e_1108fec035f017446a5@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c0fd08f5 by Sylvain Henry at 2023-02-07T12:24:47-05:00 JS: avoid head/tail and unpackFS - - - - - 67696624 by Krzysztof Gogolewski at 2023-02-07T12:24:47-05:00 testsuite: Fix Python warnings (#22856) - - - - - 10 changed files: - compiler/GHC/Core/TyCon.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/StgToJS/Printer.hs - docs/users_guide/9.6.1-notes.rst - libraries/base/GHC/Int.hs - libraries/base/GHC/Word.hs - testsuite/driver/runtests.py - testsuite/driver/testlib.py - testsuite/tests/overloadedrecflds/should_run/T11671_run.hs - testsuite/tests/printer/Test22771.hs Changes: ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -194,7 +194,7 @@ Note [Type synonym families] * Type synonym families, also known as "type functions", map directly onto the type functions in FC: - type family F a :: * + type family F a :: Type type instance F Int = Bool ..etc... @@ -210,11 +210,11 @@ Note [Type synonym families] type instance F (F Int) = ... -- BAD! * Translation of type family decl: - type family F a :: * + type family F a :: Type translates to a FamilyTyCon 'F', whose FamTyConFlav is OpenSynFamilyTyCon - type family G a :: * where + type family G a :: Type where G Int = Bool G Bool = Char G a = () @@ -229,7 +229,7 @@ Note [Data type families] See also Note [Wrappers for data instance tycons] in GHC.Types.Id.Make * Data type families are declared thus - data family T a :: * + data family T a :: Type data instance T Int = T1 | T2 Bool Here T is the "family TyCon". @@ -321,7 +321,7 @@ See also Note [Wrappers for data instance tycons] in GHC.Types.Id.Make should not think of a data family T as a *type function* at all, not even an injective one! We can't allow even injective type functions on the LHS of a type function: - type family injective G a :: * + type family injective G a :: Type type instance F (G Int) = Bool is no good, even if G is injective, because consider type instance G Int = Bool @@ -572,21 +572,21 @@ Since they are user-callable we must get their type-argument visibility information right; and that info is in the TyConBinders. Here is an example: - data App a b = MkApp (a b) -- App :: forall {k}. (k->*) -> k -> * + data App a b = MkApp (a b) -- App :: forall {k}. (k->Type) -> k -> Type The TyCon has - tyConTyBinders = [ Named (Bndr (k :: *) Inferred), Anon (k->*), Anon k ] + tyConTyBinders = [ Named (Bndr (k :: Type) Inferred), Anon (k->Type), Anon k ] The TyConBinders for App line up with App's kind, given above. But the DataCon MkApp has the type - MkApp :: forall {k} (a:k->*) (b:k). a b -> App k a b + MkApp :: forall {k} (a:k->Type) (b:k). a b -> App k a b That is, its ForAllTyBinders should be - dataConUnivTyVarBinders = [ Bndr (k:*) Inferred - , Bndr (a:k->*) Specified + dataConUnivTyVarBinders = [ Bndr (k:Type) Inferred + , Bndr (a:k->Type) Specified , Bndr (b:k) Specified ] So tyConTyVarBinders converts TyCon's TyConBinders into TyVarBinders: @@ -620,8 +620,8 @@ They fit together like so: type App a (b :: k) = a b - tyConBinders = [ Bndr (k::*) (NamedTCB Inferred) - , Bndr (a:k->*) AnonTCB + tyConBinders = [ Bndr (k::Type) (NamedTCB Inferred) + , Bndr (a:k->Type) AnonTCB , Bndr (b:k) AnonTCB ] Note that there are three binders here, including the @@ -636,13 +636,13 @@ They fit together like so: that TyVar may scope over some other part of the TyCon's definition. Eg type T a = a -> a we have - tyConBinders = [ Bndr (a:*) AnonTCB ] + tyConBinders = [ Bndr (a:Type) AnonTCB ] synTcRhs = a -> a So the 'a' scopes over the synTcRhs * From the tyConBinders and tyConResKind we can get the tyConKind E.g for our App example: - App :: forall k. (k->*) -> k -> * + App :: forall k. (k->Type) -> k -> Type We get a 'forall' in the kind for each NamedTCB, and an arrow for each AnonTCB @@ -725,15 +725,15 @@ instance Binary TyConBndrVis where -- things such as: -- -- 1) Data declarations: @data Foo = ...@ creates the @Foo@ type constructor of --- kind @*@ +-- kind @Type@ -- -- 2) Type synonyms: @type Foo = ...@ creates the @Foo@ type constructor -- -- 3) Newtypes: @newtype Foo a = MkFoo ...@ creates the @Foo@ type constructor --- of kind @* -> *@ +-- of kind @Type -> Type@ -- -- 4) Class declarations: @class Foo where@ creates the @Foo@ type constructor --- of kind @*@ +-- of kind @Constraint@ -- -- This data type also encodes a number of primitive, built in type constructors -- such as those for function and tuple types. @@ -1252,16 +1252,16 @@ data FamTyConFlav -- -- These are introduced by either a top level declaration: -- - -- > data family T a :: * + -- > data family T a :: Type -- -- Or an associated data type declaration, within a class declaration: -- -- > class C a b where - -- > data T b :: * + -- > data T b :: Type DataFamilyTyCon TyConRepName - -- | An open type synonym family e.g. @type family F x y :: * -> *@ + -- | An open type synonym family e.g. @type family F x y :: Type -> Type@ | OpenSynFamilyTyCon -- | A closed type synonym family e.g. ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -163,7 +163,6 @@ $small = [$ascsmall $unismall \_] $uniidchar = \x07 -- Trick Alex into handling Unicode. See Note [Unicode in Alex]. $idchar = [$small $large $digit $uniidchar \'] -$labelchar = [$small $large $digit $uniidchar \' \.] $unigraphic = \x06 -- Trick Alex into handling Unicode. See Note [Unicode in Alex]. $graphic = [$small $large $symbol $digit $idchar $special $unigraphic \"\'] @@ -455,7 +454,7 @@ $unigraphic / { isSmartQuote } { smart_quote_error } } <0> { - "#" $labelchar+ / { ifExtension OverloadedLabelsBit } { skip_one_varid_src ITlabelvarid } + "#" $idchar+ / { ifExtension OverloadedLabelsBit } { skip_one_varid_src ITlabelvarid } "#" \" / { ifExtension OverloadedLabelsBit } { lex_quoted_label } } ===================================== compiler/GHC/StgToJS/Printer.hs ===================================== @@ -108,19 +108,17 @@ ghcjsRenderJsV r (JHash m) where quoteIfRequired :: FastString -> Doc quoteIfRequired x - | isUnquotedKey x' = text x' - | otherwise = PP.squotes (text x') - where x' = unpackFS x - - isUnquotedKey :: String -> Bool - isUnquotedKey x | null x = False - | all isDigit x = True - | otherwise = validFirstIdent (head x) - && all validOtherIdent (tail x) + | isUnquotedKey x = ftext x + | otherwise = PP.squotes (ftext x) + isUnquotedKey :: FastString -> Bool + isUnquotedKey fs = case unpackFS fs of + [] -> False + s@(c:cs) -> all isDigit s || (validFirstIdent c && all validOtherIdent cs) validFirstIdent c = c == '_' || c == '$' || isAlpha c validOtherIdent c = isAlpha c || isDigit c + ghcjsRenderJsV r v = renderJsV defaultRenderJs r v prettyBlock :: RenderJs -> [JStat] -> Doc ===================================== docs/users_guide/9.6.1-notes.rst ===================================== @@ -84,7 +84,7 @@ Language This extends the variety syntax for constructing labels under :extension:`OverloadedLabels`. Examples of newly allowed syntax: - Leading capital letters: `#Foo` equivalant to `getLabel @"Foo"` - - Numeric characters: `#3.14` equivalent to `getLabel @"3.14"` + - Numeric characters: `#1728` equivalent to `getLabel @"1728"` - Arbitrary strings: `#"Hello, World!"` equivalent to `getLabel @"Hello, World!"` Compiler ===================================== libraries/base/GHC/Int.hs ===================================== @@ -69,8 +69,8 @@ instance Eq Int8 where (/=) = neInt8 eqInt8, neInt8 :: Int8 -> Int8 -> Bool -eqInt8 (I8# x) (I8# y) = isTrue# (x `eqInt8#` y) -neInt8 (I8# x) (I8# y) = isTrue# (x `neInt8#` y) +eqInt8 (I8# x) (I8# y) = isTrue# ((int8ToInt# x) ==# (int8ToInt# y)) +neInt8 (I8# x) (I8# y) = isTrue# ((int8ToInt# x) /=# (int8ToInt# y)) {-# INLINE [1] eqInt8 #-} {-# INLINE [1] neInt8 #-} @@ -280,8 +280,8 @@ instance Eq Int16 where (/=) = neInt16 eqInt16, neInt16 :: Int16 -> Int16 -> Bool -eqInt16 (I16# x) (I16# y) = isTrue# (x `eqInt16#` y) -neInt16 (I16# x) (I16# y) = isTrue# (x `neInt16#` y) +eqInt16 (I16# x) (I16# y) = isTrue# ((int16ToInt# x) ==# (int16ToInt# y)) +neInt16 (I16# x) (I16# y) = isTrue# ((int16ToInt# x) /=# (int16ToInt# y)) {-# INLINE [1] eqInt16 #-} {-# INLINE [1] neInt16 #-} @@ -488,8 +488,8 @@ instance Eq Int32 where (/=) = neInt32 eqInt32, neInt32 :: Int32 -> Int32 -> Bool -eqInt32 (I32# x) (I32# y) = isTrue# (x `eqInt32#` y) -neInt32 (I32# x) (I32# y) = isTrue# (x `neInt32#` y) +eqInt32 (I32# x) (I32# y) = isTrue# ((int32ToInt# x) ==# (int32ToInt# y)) +neInt32 (I32# x) (I32# y) = isTrue# ((int32ToInt# x) /=# (int32ToInt# y)) {-# INLINE [1] eqInt32 #-} {-# INLINE [1] neInt32 #-} ===================================== libraries/base/GHC/Word.hs ===================================== @@ -78,8 +78,8 @@ instance Eq Word8 where (/=) = neWord8 eqWord8, neWord8 :: Word8 -> Word8 -> Bool -eqWord8 (W8# x) (W8# y) = isTrue# (x `eqWord8#` y) -neWord8 (W8# x) (W8# y) = isTrue# (x `neWord8#` y) +eqWord8 (W8# x) (W8# y) = isTrue# ((word8ToWord# x) `eqWord#` (word8ToWord# y)) +neWord8 (W8# x) (W8# y) = isTrue# ((word8ToWord# x) `neWord#` (word8ToWord# y)) {-# INLINE [1] eqWord8 #-} {-# INLINE [1] neWord8 #-} @@ -268,8 +268,8 @@ instance Eq Word16 where (/=) = neWord16 eqWord16, neWord16 :: Word16 -> Word16 -> Bool -eqWord16 (W16# x) (W16# y) = isTrue# (x `eqWord16#` y) -neWord16 (W16# x) (W16# y) = isTrue# (x `neWord16#` y) +eqWord16 (W16# x) (W16# y) = isTrue# ((word16ToWord# x) `eqWord#` (word16ToWord# y)) +neWord16 (W16# x) (W16# y) = isTrue# ((word16ToWord# x) `neWord#` (word16ToWord# y)) {-# INLINE [1] eqWord16 #-} {-# INLINE [1] neWord16 #-} @@ -500,8 +500,8 @@ instance Eq Word32 where (/=) = neWord32 eqWord32, neWord32 :: Word32 -> Word32 -> Bool -eqWord32 (W32# x) (W32# y) = isTrue# (x `eqWord32#` y) -neWord32 (W32# x) (W32# y) = isTrue# (x `neWord32#` y) +eqWord32 (W32# x) (W32# y) = isTrue# ((word32ToWord# x) `eqWord#` (word32ToWord# y)) +neWord32 (W32# x) (W32# y) = isTrue# ((word32ToWord# x) `neWord#` (word32ToWord# y)) {-# INLINE [1] eqWord32 #-} {-# INLINE [1] neWord32 #-} ===================================== testsuite/driver/runtests.py ===================================== @@ -601,6 +601,7 @@ else: if args.junit: junit(t).write(args.junit) + args.junit.close() if config.only_report_hadrian_deps: print("WARNING - skipping all tests and only reporting required hadrian dependencies:", config.hadrian_deps) ===================================== testsuite/driver/testlib.py ===================================== @@ -1347,7 +1347,7 @@ def do_test(name: TestName, # if found and instead have the testsuite decide on what to do # with the output. def override_options(pre_cmd): - if config.verbose >= 5 and bool(re.match('\$make', pre_cmd, re.I)): + if config.verbose >= 5 and bool(re.match(r'\$make', pre_cmd, re.I)): return pre_cmd.replace(' -s' , '') \ .replace('--silent', '') \ .replace('--quiet' , '') @@ -1989,7 +1989,7 @@ def split_file(in_fn: Path, delimiter: str, out1_fn: Path, out2_fn: Path): with out1_fn.open('w', encoding='utf8', newline='') as out1: with out2_fn.open('w', encoding='utf8', newline='') as out2: line = infile.readline() - while re.sub('^\s*','',line) != delimiter and line != '': + while re.sub(r'^\s*','',line) != delimiter and line != '': out1.write(line) line = infile.readline() @@ -2399,20 +2399,20 @@ def normalise_errmsg(s: str) -> str: # warning message to get clean output. if config.msys: s = re.sub('Failed to remove file (.*); error= (.*)$', '', s) - s = re.sub('DeleteFile "(.+)": permission denied \(Access is denied\.\)(.*)$', '', s) + s = re.sub(r'DeleteFile "(.+)": permission denied \(Access is denied\.\)(.*)$', '', s) # filter out unsupported GNU_PROPERTY_TYPE (5), which is emitted by LLVM10 # and not understood by older binutils (ar, ranlib, ...) - s = modify_lines(s, lambda l: re.sub('^(.+)warning: (.+): unsupported GNU_PROPERTY_TYPE \(5\) type: 0xc000000(.*)$', '', l)) + s = modify_lines(s, lambda l: re.sub(r'^(.+)warning: (.+): unsupported GNU_PROPERTY_TYPE \(5\) type: 0xc000000(.*)$', '', l)) - s = re.sub('ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) + s = re.sub(r'ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) s = re.sub('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version','',s) # ignore superfluous dylibs passed to the linker. s = re.sub('ld: warning: .*, ignoring unexpected dylib file\n','',s) # ignore LLVM Version mismatch garbage; this will just break tests. s = re.sub('You are using an unsupported version of LLVM!.*\n','',s) - s = re.sub('Currently only [\.0-9]+ is supported. System LLVM version: [\.0-9]+.*\n','',s) - s = re.sub('We will try though\.\.\..*\n','',s) + s = re.sub('Currently only [\\.0-9]+ is supported. System LLVM version: [\\.0-9]+.*\n','',s) + s = re.sub('We will try though\\.\\.\\..*\n','',s) # ignore warning about strip invalidating signatures s = re.sub('.*strip: changes being made to the file will invalidate the code signature in.*\n','',s) # clang may warn about unused argument when used as assembler @@ -2475,8 +2475,8 @@ def normalise_slashes_( s: str ) -> str: return s def normalise_exe_( s: str ) -> str: - s = re.sub('\.exe', '', s) - s = re.sub('\.jsexe', '', s) + s = re.sub(r'\.exe', '', s) + s = re.sub(r'\.jsexe', '', s) return s def normalise_output( s: str ) -> str: @@ -2494,14 +2494,14 @@ def normalise_output( s: str ) -> str: # ghci outputs are pretty unstable with -fexternal-dynamic-refs, which is # requires for -fPIC s = re.sub(' -fexternal-dynamic-refs\n','',s) - s = re.sub('ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) + s = re.sub(r'ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) s = re.sub('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version','',s) # ignore superfluous dylibs passed to the linker. s = re.sub('ld: warning: .*, ignoring unexpected dylib file\n','',s) # ignore LLVM Version mismatch garbage; this will just break tests. s = re.sub('You are using an unsupported version of LLVM!.*\n','',s) - s = re.sub('Currently only [\.0-9]+ is supported. System LLVM version: [\.0-9]+.*\n','',s) - s = re.sub('We will try though\.\.\..*\n','',s) + s = re.sub('Currently only [\\.0-9]+ is supported. System LLVM version: [\\.0-9]+.*\n','',s) + s = re.sub('We will try though\\.\\.\\..*\n','',s) # ignore warning about strip invalidating signatures s = re.sub('.*strip: changes being made to the file will invalidate the code signature in.*\n','',s) # clang may warn about unused argument when used as assembler ===================================== testsuite/tests/overloadedrecflds/should_run/T11671_run.hs ===================================== @@ -12,8 +12,9 @@ import GHC.Prim (Addr#) instance KnownSymbol symbol => IsLabel symbol String where fromLabel = symbolVal (Proxy :: Proxy symbol) -(#) :: String -> Int -> String +(#), (#.) :: String -> Int -> String (#) _ i = show i +_ #. i = show i f :: Addr# -> Int -> String f _ i = show i @@ -26,13 +27,13 @@ main = traverse_ putStrLn , #type , #Foo , #3 - , #199.4 + , #"199.4" , #17a23b , #f'a' , #'a' , #' , #''notTHSplice - , #... + , #"..." , #привет , #こんにちは , #"3" ===================================== testsuite/tests/printer/Test22771.hs ===================================== @@ -14,8 +14,9 @@ import GHC.Prim (Addr#) instance KnownSymbol symbol => IsLabel symbol String where fromLabel = symbolVal (Proxy :: Proxy symbol) -(#) :: String -> Int -> String +(#), (#.) :: String -> Int -> String (#) _ i = show i +_ #. i = show i f :: Addr# -> Int -> String f _ i = show i @@ -28,13 +29,13 @@ main = traverse_ putStrLn , #type , #Foo , #3 - , #199.4 + , #"199.4" , #17a23b , #f'a' , #'a' , #' , #''notTHSplice - , #... + , #"..." , #привет , #こんにちは , #"3" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7b9365d0de5e506ddc9a8cc6ee40c25f36f6485b...6769662417abe3d39cefeca0b97c4601183b0ad0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7b9365d0de5e506ddc9a8cc6ee40c25f36f6485b...6769662417abe3d39cefeca0b97c4601183b0ad0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 17:25:58 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 07 Feb 2023 12:25:58 -0500 Subject: [Git][ghc/ghc][wip/T22264-9.2] 49 commits: Allow keywords which can be used as variables to be used with OverloadedDotSyntax Message-ID: <63e289a697029_1108fe56cecbdc1747729@gitlab.mail> Ben Gamari pushed to branch wip/T22264-9.2 at Glasgow Haskell Compiler / GHC Commits: 1b48378e by Matthew Pickering at 2023-01-23T13:37:08+05:30 Allow keywords which can be used as variables to be used with OverloadedDotSyntax There are quite a few keywords which are allowed to be used as variables. Such as "as", "dependency" etc. These weren't accepted by OverloadedDotSyntax. The fix is pretty simple, use the varid production rather than raw VARID. Fixes #20723 (cherry picked from commit 02372be119bd1a4e7099d2c7d5bb3de096e99409) - - - - - 6eaf0d3d by Andreas Klebinger at 2023-02-07T18:47:08+05:30 Fix #22425 - Broken eta-expansion over expensive work. This is the 9.2 backport of !9357 Through a mistake in the latest backport we started eta-expanding over expensive work by mistake. E.g. over <expensive> in code like: case x of A -> id B -> <expensive> We fix this by only eta-expanding over <expensive> if all other branches are headed by an oneShot lambda. In the long story of broken eta-expansion on 9.2/9.4 this is hopefully the last chapter. ------------------------- Metric Increase: CoOpt_Read T1969 parsing001 TcPlugin_RewritePerf LargeRecord ------------------------- (cherry picked from commit ce608479c7f40a9899a6448379d05861bee77b41) - - - - - fed9cff1 by Simon Peyton Jones at 2023-02-07T18:47:08+05:30 Add a missing varToCoreExpr in etaBodyForJoinPoint This subtle bug showed up when compiling a library with 9.4. See #22491. The bug is present in master, but it is hard to trigger; the new regression test T22491 fails in 9.4. The fix was easy: just add a missing varToCoreExpr in etaBodyForJoinPoint. The fix is definitely right though! I also did some other minor refatoring: * Moved the preInlineUnconditionally test in simplExprF1 to before the call to joinPointBinding_maybe, to avoid fruitless eta-expansion. * Added a boolean from_lam flag to simplNonRecE, to avoid two fruitless tests, and commented it a bit better. These refactorings seem to save 0.1% on compile-time allocation in perf/compiler; with a max saving of 1.4% in T9961 Metric Decrease: T9961 (cherry picked from commit afc2540daf6ca6baa09ab147b792da08d66d878c) - - - - - ce180d2f by Matthew Pickering at 2023-02-07T18:47:08+05:30 Typeable: Fix module locations of some definitions in GHC.Types There was some confusion in Data.Typeable about which module certain wired-in things were defined in. Just because something is wired-in doesn't mean it comes from GHC.Prim, in particular things like LiftedRep and RuntimeRep are defined in GHC.Types and that's the end of the story. Things like Int#, Float# etc are defined in GHC.Prim as they have no Haskell definition site at all so we need to generate type representations for them (which live in GHC.Types). Fixes #22510 (cherry picked from commit 1d3a8b8ec98e6eedf8943e19780ec374c2491e7f) - - - - - aac592f3 by Andreas Klebinger at 2023-02-07T18:47:08+05:30 Fix LitRubbish being applied to values. This fixes #19824 This is the 9.2 backport of commit 52ce8590ab18fb1fc99bd9aa24c016f786d7f7d1 (cherry picked from commit 2e02959ab40f2b67499aaffc29ee1dc9f0d48158) - - - - - 8aaf86f8 by Simon Peyton Jones at 2023-02-07T18:47:08+05:30 Fix unifier bug: failing to decompose over-saturated type family This simple patch fixes #22647 (cherry picked from commit 317f45c154f6fe25d50ef2f3febcc5883ff1b1ca) - - - - - 03da82af by Sebastian Graf at 2023-02-07T18:47:08+05:30 Handle shadowing in DmdAnal (#22718) Previously, when we had a shadowing situation like ```hs f x = ... -- demand signature <1L><1L> main = ... \f -> f 1 ... ``` we'd happily use the shadowed demand signature at the call site inside the lambda. Of course, that's wrong and solution is simply to remove the demand signature from the `AnalEnv` when we enter the lambda. This patch does so for all binding constructs Core. In #22718 the issue was caused by LetUp not shadowing away the existing demand signature for the let binder in the let body. The resulting absent error is fickle to reproduce; hence no reproduction test case. #17478 would help. Fixes #22718. It appears that TcPlugin_Rewrite regresses by ~40% on Darwin. It is likely that DmdAnal was exploiting ill-scoped analysis results. Metric increase ['bytes allocated'] (test_env=x86_64-darwin-validate): TcPlugin_Rewrite (cherry picked from commit e3fff7512bbf989386faaa1dccafdad1deabde84) - - - - - 7e47d0f5 by Zubin Duggal at 2023-02-07T18:47:09+05:30 Bump bytestring submodule to 0.11.4.0 - - - - - d130b39f by Andreas Klebinger at 2023-02-07T18:47:09+05:30 Only gc sparks locally when we can ensure marking is done. When performing GC without work stealing there was no guarantee that spark pruning was happening after marking of the sparks. This could cause us to GC live sparks under certain circumstances. Fixes #22528. (cherry picked from commit a1491c8791c57a64d94bc08d639d585815c8d4e2) - - - - - 5b2af591 by Ian-Woo Kim at 2023-02-07T18:47:09+05:30 Truncate eventlog event for large payload (#20221) RTS eventlog events for postCapsetVecEvent are truncated if payload is larger than EVENT_PAYLOAD_SIZE_MAX Previously, postCapsetVecEvent records eventlog event with payload of variable size larger than EVENT_PAYLOAD_SIZE_MAX (2^16) without any validation, resulting in corrupted data. For example, this happens when a Haskell binary is invoked with very long command line arguments exceeding 2^16 bytes (see #20221). Now we check the size of accumulated payload messages incrementally, and truncate the message just before the payload size exceeds EVENT_PAYLOAD_SIZE_MAX. RTS will warn the user with a message showing how many arguments are truncated. (cherry picked from commit 2057c77d08cb8422857d182a3691f98dccd0c7d6) - - - - - ec04fbed by Simon Peyton Jones at 2023-02-07T18:47:09+05:30 Make FloatIn robust to shadowing This MR fixes #22622. See the new Note [Shadowing and name capture] I did a bit of refactoring in sepBindsByDropPoint too. The bug doesn't manifest in HEAD, but it did show up in 9.4, so we should backport this patch to 9.4 (cherry picked from commit 6206cb9287f3f6e70c669660a646a65274870d2b) - - - - - a225dbb1 by Ben Gamari at 2023-02-07T18:47:09+05:30 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. (cherry picked from commit f891a442046d8a5ebf4d4777847880ce06752b18) - - - - - cf2da09a by Ben Gamari at 2023-02-07T18:47:09+05:30 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. (cherry picked from commit b13c6ea5d4b64841164f8cc58d6c6f3de390f2ed) - - - - - 09224b90 by Oleg Grenrus at 2023-02-07T18:47:09+05:30 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general (cherry picked from commit 1b812b6973a25cb1962e2fc543d2c4ed3cf31f3c) - - - - - 27f154f9 by Zubin Duggal at 2023-02-07T18:47:09+05:30 Document #22255 and #22468 in bugs.rst - - - - - c63a3e25 by Simon Peyton Jones at 2023-02-07T18:47:09+05:30 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 (cherry picked from commit 3d55d8ab51ece43c51055c43c9e7aba77cce46c0) - - - - - eadbbbcf by Simon Peyton Jones at 2023-02-07T18:47:09+05:30 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. (cherry picked from commit e193e53790dd5886feea3cf4c9c17625d188291b) - - - - - a090f5c3 by Sebastian Graf at 2023-02-07T18:47:09+05:30 DmdAnal: Don't panic in addCaseBndrDmd (#22039) Rather conservatively return Top. See Note [Untyped demand on case-alternative binders]. I also factored `addCaseBndrDmd` into two separate functions `scrutSubDmd` and `fieldBndrDmds`. Fixes #22039. (cherry picked from commit d2be80fd9b222963e8dd09a30f78c106e00da7f9) - - - - - 52e579b6 by Matthew Pickering at 2023-02-07T18:47:09+05:30 ApplicativeDo: Set pattern location before running exhaustiveness checker This improves the error messages of the exhaustiveness checker when checking statements which have been moved around with ApplicativeDo. Before: Test.hs:2:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 2 | let x = () | ^^^^^^^^^^ After: Test.hs:4:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 4 | ~(Just res1) <- seq x (pure $ Nothing @()) | Fixes #22483 (cherry picked from commit 74c767df770766d8d52e87b9ff7da10f94620a91) (cherry picked from commit 51c6051bcc405bc1dbddd450ade949acd70db6b8) - - - - - 96ab827a by Andreas Klebinger at 2023-02-07T18:47:09+05:30 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- (cherry picked from commit 08ba87200ff068aa37cac082e61ee7e2d534daf5) - - - - - 898ca9c6 by Matthew Pickering at 2023-02-07T18:47:09+05:30 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s (cherry picked from commit a960ca817d6ad0109ea6edda50da3902cc538e86) - - - - - 8e0c0da5 by Matthew Pickering at 2023-02-07T18:47:09+05:30 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. (cherry picked from commit 734847108420cf826a807c30ad54651659cf3a08) - - - - - 8ef4fec1 by Matthew Pickering at 2023-02-07T18:47:09+05:30 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes (cherry picked from commit 8c0ea25fb4a27d4729aabf73f4c00b912bb0c58d) - - - - - 2df830a1 by Cheng Shao at 2023-02-07T18:47:09+05:30 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. (cherry picked from commit c45a5fffef2c76efbf5d3a009c3f6d0244a63f0d) - - - - - 15d34a97 by Ben Gamari at 2023-02-07T18:47:09+05:30 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. (cherry picked from commit be417a47c7695998dea0adc05489a7b8838a78b6) - - - - - 34baa6e9 by Ben Gamari at 2023-02-07T18:47:10+05:30 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. (cherry picked from commit 30989d137b8f3a8fddbfd116e04b48f23c24f86c) - - - - - d5eea69c by Ben Gamari at 2023-02-07T18:47:10+05:30 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. (cherry picked from commit 7566fd9de38c67360c090f828923d41587af519c) - - - - - 8d846b8a by Ben Gamari at 2023-02-07T18:47:10+05:30 testsuite: Add regression test for #22798 (cherry picked from commit 2cb500a5ee1a31dfe1a2cdd71f175442026eb082) - - - - - 7262d71f by Zubin Duggal at 2023-02-07T18:47:10+05:30 hadrian: enable -haddock in perf flavour (#22734) - - - - - 0b54f4cd by Zubin Duggal at 2023-02-07T18:47:10+05:30 Bump version to GHC 9.2.6 and add changelog entries - - - - - be4b41cf by Zubin Duggal at 2023-02-07T10:25:56-05:00 Allow stat increases for GHC 9.2 Metric Increase: T13701 T14697 - - - - - 256d4e9e by Ben Gamari at 2023-02-07T12:20:27-05:00 rts: Introduce getNumCapabilities And ensure accesses to n_capabilities are atomic (although with relaxed ordering). This is necessary as RTS API callers may concurrently call into the RTS without holding a capability. (cherry picked from commit 70999283156f527c5aea6dee57a3d14989a9903a) - - - - - fbfa067e by Ben Gamari at 2023-02-07T12:20:28-05:00 nonmoving: Don't show occupancy if we didn't collect live words (cherry picked from commit fcd9794163f6ae7af8783676ee79e0b8e78167ba) - - - - - 27d81791 by Ben Gamari at 2023-02-07T12:20:29-05:00 nonmoving: Refactor update remembered set initialization This avoids a lock inversion between the storage manager mutex and the stable pointer table mutex by not dropping the SM_MUTEX in nonmovingCollect. This requires quite a bit of rejiggering but it does seem like a better strategy. (cherry picked from commit 543cae0084a72ca767a443d857f9e65a5a79f71d) - - - - - 401377aa by Ben Gamari at 2023-02-07T12:20:29-05:00 nonmoving: Fix style (cherry picked from commit b642ef1dc4cbe19c3479b2c014e7d1f7959f8e4a) - - - - - 21f2bb7d by Ben Gamari at 2023-02-07T12:20:29-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Likely fixes the cause of #22264. (cherry picked from commit f8988a9c53ae73ff5b9c6008f467a7171e99c61f) - - - - - 460be2c4 by Ben Gamari at 2023-02-07T12:20:29-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. (cherry picked from commit a999f7b5b4b7316c088d7233a452fb33dc17646f) - - - - - e8650d79 by Ben Gamari at 2023-02-07T12:20:29-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. (cherry picked from commit 48b89dba91640fa977d038ea5283019c73f1b18e) - - - - - 130312f2 by Ben Gamari at 2023-02-07T12:20:29-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive (cherry picked from commit 36ca160d0f199a688cf5fbc91d4bb92d2d4ea14e) - - - - - 5aaef3a6 by Ben Gamari at 2023-02-07T12:20:29-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. (cherry picked from commit 8b64aff0fa978c762dfae8df235dd2b2a340656a) - - - - - 939fecfe by Ben Gamari at 2023-02-07T12:20:29-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. (cherry picked from commit dde67d6e32ecff0e400f98213d42ae790babac09) - - - - - 077a6827 by Ben Gamari at 2023-02-07T12:20:29-05:00 nonmoving: Don't push if nonmoving collector isn't enabled (cherry picked from commit 8adc1750c02e596b4014d2837b4eb3d76bd130f2) - - - - - 3683e451 by Ben Gamari at 2023-02-07T12:20:29-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. (cherry picked from commit c620669651c52fd228af61040747dd7236c4ba2b) - - - - - 9581c1fb by Ben Gamari at 2023-02-07T12:20:29-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys (cherry picked from commit 3887132fcd20f0a1edfc9f7006bdbed2634e2a8d) - - - - - e9256875 by Ben Gamari at 2023-02-07T12:20:29-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. (cherry picked from commit cc75031b4d93d4565e0428cb5910d9b9a645485b) - - - - - aa5a655b by Ben Gamari at 2023-02-07T12:20:29-05:00 nonmoving: Add missing no-op in busy-wait loop (cherry picked from commit 9f931a8801c84b8ae473f91349e144eebc73b415) - - - - - 5c201529 by Ben Gamari at 2023-02-07T12:20:29-05:00 nonmoving: Move current segment array into Capability (cherry picked from commit 9d245c1baec91ee79d715062b127e487456d9c9e) - - - - - ed7de966 by Ben Gamari at 2023-02-07T12:20:29-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. (cherry picked from commit 6bdce35cdd59112a8cb4a4a3b061e854ada3ff63) - - - - - fdebde76 by Ben Gamari at 2023-02-07T12:20:29-05:00 nonmoving: Fix unregisterised build (cherry picked from commit 6df2709e7215ea80d7267800e0318aee2a7c277f) - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Parser.y - compiler/GHC/Tc/Instance/Typeable.hs - compiler/cbits/keepCAFsForGHCi.c - compiler/ghc.mk - configure.ac - docs/users_guide/9.2.1-notes.rst - + docs/users_guide/9.2.6-notes.rst - docs/users_guide/bugs.rst - docs/users_guide/release-notes.rst - hadrian/src/Settings/Flavours/Performance.hs - includes/rts/Threads.h - libraries/bytestring - libraries/ghc-bignum/gmp/gmp-tarballs - + m4/fp_ld_no_fixup_chains.m4 - rts/Capability.c - rts/Capability.h - rts/Messages.h - rts/PrimOps.cmm - rts/Printer.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/18d6ad8a51b4fdc740934f8260fb4b4e4ab825e5...fdebde7650dd61debcd941f894f397e7e30e3644 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/18d6ad8a51b4fdc740934f8260fb4b4e4ab825e5...fdebde7650dd61debcd941f894f397e7e30e3644 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 18:57:46 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 07 Feb 2023 13:57:46 -0500 Subject: [Git][ghc/ghc][wip/revert-dont-kee-exit-joins] Revert "Don't keep exit join points so much" Message-ID: <63e29f2ac2ab7_1108fe5263418049d7@gitlab.mail> Matthew Pickering pushed to branch wip/revert-dont-kee-exit-joins at Glasgow Haskell Compiler / GHC Commits: ff9e4063 by Matthew Pickering at 2023-02-07T18:57:24+00:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 11 changed files: - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - − testsuite/tests/simplCore/should_compile/T21148.hs - − testsuite/tests/simplCore/should_compile/T21148.stderr - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/stranal/should_compile/T21128.hs - testsuite/tests/stranal/should_compile/T21128.stderr Changes: ===================================== compiler/GHC/Core/Opt/Exitify.hs ===================================== @@ -433,7 +433,6 @@ inlining. Exit join points, recognizable using `isExitJoinId` are join points with an occurrence in a recursive group, and can be recognized (after the occurrence analyzer ran!) using `isExitJoinId`. - This function detects joinpoints with `occ_in_lam (idOccinfo id) == True`, because the lambdas of a non-recursive join point are not considered for `occ_in_lam`. For example, in the following code, `j1` is /not/ marked @@ -447,29 +446,6 @@ To prevent inlining, we check for isExitJoinId * In `simplLetUnfolding` we simply give exit join points no unfolding, which prevents inlining in `postInlineUnconditionally` and call sites. -But see Note [Be selective about not-inlining exit join points] - -Note [Be selective about not-inlining exit join points] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If we follow "do not inline exit join points" mantra throughout, -some bad things happen. - -* We can lose CPR information: see #21148 - -* We get useless clutter (#22084) that - - makes the program bigger (including duplicated code #20739), and - - adds extra jumps (and maybe stack saves) at runtime - -So instead we follow "do not inline exit join points" for a /single run/ -of the simplifier, right after Exitification. That should give a -sufficient chance for used-once things to inline, but subsequent runs -will inline them back in. (Annoyingly, as things stand, only with -O2 -is there a subsequent run, but that might change, and it's not a huge -deal anyway.) - -This is controlled by the Simplifier's sm_keep_exits flag; see -GHC.Core.Opt.Pipeline. - Note [Placement of the exitification pass] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ I (Joachim) experimented with multiple positions for the Exitification pass in ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -15,7 +15,7 @@ import GHC.Driver.Plugins ( withPlugins, installCoreToDos ) import GHC.Driver.Env import GHC.Driver.Config.Core.Lint ( endPass ) import GHC.Driver.Config.Core.Opt.LiberateCase ( initLiberateCaseOpts ) -import GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyOpts, initSimplMode ) +import GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyOpts, initSimplMode, initGentleSimplMode ) import GHC.Driver.Config.Core.Opt.WorkWrap ( initWorkWrapOpts ) import GHC.Driver.Config.Core.Rules ( initRuleOpts ) import GHC.Platform.Ways ( hasWay, Way(WayProf) ) @@ -28,7 +28,6 @@ import GHC.Core.Utils ( dumpIdInfoOfProgram ) import GHC.Core.Lint ( lintAnnots ) import GHC.Core.Lint.Interactive ( interactiveInScope ) import GHC.Core.Opt.Simplify ( simplifyExpr, simplifyPgm ) -import GHC.Core.Opt.Simplify.Env( SimplMode(..) ) import GHC.Core.Opt.Simplify.Monad import GHC.Core.Opt.Monad import GHC.Core.Opt.Pipeline.Types @@ -153,45 +152,32 @@ getCoreToDo dflags hpt_rule_base extra_vars maybe_strictness_before _ = CoreDoNothing - ---------------------------- - base_simpl_mode :: SimplMode - base_simpl_mode = initSimplMode dflags - - -- gentle_mode: make specialiser happy: minimum effort please - -- See Note [Inline in InitialPhase] - -- See Note [RULEs enabled in InitialPhase] - gentle_mode = base_simpl_mode { sm_names = ["Gentle"] - , sm_phase = InitialPhase - , sm_case_case = False } - - simpl_mode phase name - = base_simpl_mode { sm_names = [name], sm_phase = phase } - - keep_exits :: SimplMode -> SimplMode - -- See Note [Be selective about not-inlining exit join points] - -- in GHC.Core.Opt.Exitify - keep_exits mode = mode { sm_keep_exits = True } - - ---------------------------- - run_simplifier mode iter - = CoreDoSimplify $ initSimplifyOpts dflags extra_vars iter mode hpt_rule_base - - simpl_phase phase name iter = CoreDoPasses $ - [ maybe_strictness_before phase - , run_simplifier (simpl_mode phase name) iter - , maybe_rule_check phase ] + simpl_phase phase name iter + = CoreDoPasses + $ [ maybe_strictness_before phase + , CoreDoSimplify $ initSimplifyOpts dflags extra_vars iter + (initSimplMode dflags phase name) hpt_rule_base + , maybe_rule_check phase ] -- Run GHC's internal simplification phase, after all rules have run. -- See Note [Compiler phases] in GHC.Types.Basic - simpl_gently = run_simplifier gentle_mode max_iter - simplify_final name = run_simplifier ( simpl_mode FinalPhase name) max_iter - simpl_keep_exits name = run_simplifier (keep_exits $ simpl_mode FinalPhase name) max_iter + simplify name = simpl_phase FinalPhase name max_iter + + -- initial simplify: mk specialiser happy: minimum effort please + -- See Note [Inline in InitialPhase] + -- See Note [RULEs enabled in InitialPhase] + simpl_gently = CoreDoSimplify $ initSimplifyOpts dflags extra_vars max_iter + (initGentleSimplMode dflags) hpt_rule_base - ---------------------------- dmd_cpr_ww = if ww_on then [CoreDoDemand True,CoreDoCpr,CoreDoWorkerWrapper] else [CoreDoDemand False] -- NB: No CPR! See Note [Don't change boxity without worker/wrapper] + demand_analyser = (CoreDoPasses ( + dmd_cpr_ww ++ + [simplify "post-worker-wrapper"] + )) + -- Static forms are moved to the top level with the FloatOut pass. -- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable. static_ptrs_float_outwards = @@ -281,16 +267,14 @@ getCoreToDo dflags hpt_rule_base extra_vars runWhen call_arity $ CoreDoPasses [ CoreDoCallArity - , simplify_final "post-call-arity" + , simplify "post-call-arity" ], -- Strictness analysis - runWhen strictness $ CoreDoPasses - (dmd_cpr_ww ++ [simplify_final "post-worker-wrapper"]), + runWhen strictness demand_analyser, runWhen exitification CoreDoExitify, -- See Note [Placement of the exitification pass] - -- in GHC.Core.Opt.Exitify runWhen full_laziness $ CoreDoFloatOutwards FloatOutSwitches { @@ -312,17 +296,7 @@ getCoreToDo dflags hpt_rule_base extra_vars runWhen do_float_in CoreDoFloatInwards, - -- Final tidy-up run of the simplifier - simpl_keep_exits "final tidy up", - -- Keep exit join point because this is the first - -- Simplifier run after Exitify. Subsequent runs will - -- re-inline those exit join points; their work is done. - -- See Note [Be selective about not-inlining exit join points] - -- in GHC.Core.Opt.Exitify - -- - -- Annoyingly, we only /have/ a subsequent run with -O2. With - -- plain -O we'll still have those exit join points hanging around. - -- Oh well. + simplify "final", -- Final tidy-up maybe_rule_check FinalPhase, @@ -332,31 +306,31 @@ getCoreToDo dflags hpt_rule_base extra_vars -- Case-liberation for -O2. This should be after -- strictness analysis and the simplification which follows it. runWhen liberate_case $ CoreDoPasses - [ CoreLiberateCase, simplify_final "post-liberate-case" ], + [ CoreLiberateCase, simplify "post-liberate-case" ], -- Run the simplifier after LiberateCase to vastly -- reduce the possibility of shadowing -- Reason: see Note [Shadowing] in GHC.Core.Opt.SpecConstr runWhen spec_constr $ CoreDoPasses - [ CoreDoSpecConstr, simplify_final "post-spec-constr"], + [ CoreDoSpecConstr, simplify "post-spec-constr"], -- See Note [Simplify after SpecConstr] maybe_rule_check FinalPhase, runWhen late_specialise $ CoreDoPasses - [ CoreDoSpecialising, simplify_final "post-late-spec"], + [ CoreDoSpecialising, simplify "post-late-spec"], -- LiberateCase can yield new CSE opportunities because it peels -- off one layer of a recursive function (concretely, I saw this -- in wheel-sieve1), and I'm guessing that SpecConstr can too -- And CSE is a very cheap pass. So it seems worth doing here. runWhen ((liberate_case || spec_constr) && cse) $ CoreDoPasses - [ CoreCSE, simplify_final "post-final-cse" ], + [ CoreCSE, simplify "post-final-cse" ], --------- End of -O2 passes -------------- runWhen late_dmd_anal $ CoreDoPasses ( - dmd_cpr_ww ++ [simplify_final "post-late-ww"] + dmd_cpr_ww ++ [simplify "post-late-ww"] ), -- Final run of the demand_analyser, ensures that one-shot thunks are ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -248,16 +248,13 @@ data SimplMode = SimplMode -- See comments in GHC.Core.Opt.Simplify.Monad , sm_uf_opts :: !UnfoldingOpts -- ^ Unfolding options , sm_case_case :: !Bool -- ^ Whether case-of-case is enabled , sm_pre_inline :: !Bool -- ^ Whether pre-inlining is enabled - , sm_keep_exits :: !Bool -- ^ True <=> keep ExitJoinIds - -- See Note [Do not inline exit join points] - -- in GHC.Core.Opt.Exitify - , sm_float_enable :: !FloatEnable -- ^ Whether to enable floating out + , sm_float_enable :: !FloatEnable -- ^ Whether to enable floating out , sm_do_eta_reduction :: !Bool - , sm_arity_opts :: !ArityOpts - , sm_rule_opts :: !RuleOpts - , sm_case_folding :: !Bool - , sm_case_merge :: !Bool - , sm_co_opt_opts :: !OptCoercionOpts -- ^ Coercion optimiser options + , sm_arity_opts :: !ArityOpts + , sm_rule_opts :: !RuleOpts + , sm_case_folding :: !Bool + , sm_case_merge :: !Bool + , sm_co_opt_opts :: !OptCoercionOpts -- ^ Coercion optimiser options } instance Outputable SimplMode where ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1395,11 +1395,11 @@ preInlineUnconditionally -- Reason: we don't want to inline single uses, or discard dead bindings, -- for unlifted, side-effect-ful bindings preInlineUnconditionally env top_lvl bndr rhs rhs_env - | not pre_inline = Nothing + | not pre_inline_unconditionally = Nothing | not active = Nothing | isTopLevel top_lvl && isDeadEndId bndr = Nothing -- Note [Top-level bottoming Ids] | isCoVar bndr = Nothing -- Note [Do not inline CoVars unconditionally] - | keep_exits, isExitJoinId bndr = Nothing -- Note [Do not inline exit join points] + | isExitJoinId bndr = Nothing -- Note [Do not inline exit join points] -- in module Exitify | not (one_occ (idOccInfo bndr)) = Nothing | not (isStableUnfolding unf) = Just $! (extend_subst_with rhs) @@ -1409,36 +1409,19 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env , Just inl <- maybeUnfoldingTemplate unf = Just $! (extend_subst_with inl) | otherwise = Nothing where - mode = seMode env - phase = sm_phase mode - keep_exits = sm_keep_exits mode - pre_inline = sm_pre_inline mode - unf = idUnfolding bndr extend_subst_with inl_rhs = extendIdSubst env bndr $! (mkContEx rhs_env inl_rhs) one_occ IAmDead = True -- Happens in ((\x.1) v) - one_occ OneOcc{ occ_n_br = 1 , occ_in_lam = NotInsideLam } = isNotTopLevel top_lvl || early_phase - one_occ OneOcc{ occ_n_br = 1 , occ_in_lam = IsInsideLam , occ_int_cxt = IsInteresting } = canInlineInLam rhs + one_occ _ = False - one_occ OneOcc{ occ_n_br = 1 } -- Inline join point that are used once, even inside - | isJoinId bndr = True -- lambdas (which are presumably other join points) - -- E.g. join j x = rhs in - -- joinrec k y = ....j x.... - -- Here j must be an exit for k, and we can safely inline it under the lambda - -- This includes the case where j is nullary: a nullary join point is just the - -- same as an arity-1 one. So we don't look at occ_int_cxt. - -- All of this only applies if keep_exits is False, otherwise the - -- earlier guard on preInlineUnconditionally would have fired - - one_occ _ = False - - active = isActive phase (inlinePragmaActivation inline_prag) + pre_inline_unconditionally = sePreInline env + active = isActive (sePhase env) (inlinePragmaActivation inline_prag) -- See Note [pre/postInlineUnconditionally in gentle mode] inline_prag = idInlinePragma bndr @@ -1470,7 +1453,7 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env -- not ticks. Counting ticks cannot be duplicated, and non-counting -- ticks around a Lam will disappear anyway. - early_phase = phase /= FinalPhase + early_phase = sePhase env /= FinalPhase -- If we don't have this early_phase test, consider -- x = length [1,2,3] -- The full laziness pass carefully floats all the cons cells to ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -1532,10 +1532,8 @@ scExpr' env (Case scrut b ty alts) scrut_occ = case con of DataAlt dc -- See Note [Do not specialise evals] | not (single_alt && all deadArgOcc arg_occs) - -> -- pprTrace "sc_alt1" (ppr b' $$ ppr con $$ ppr bs $$ ppr arg_occs) $ - ScrutOcc (unitUFM dc arg_occs) - _ -> -- pprTrace "sc_alt1" (ppr b' $$ ppr con $$ ppr bs $$ ppr arg_occs) $ - UnkOcc + -> ScrutOcc (unitUFM dc arg_occs) + _ -> UnkOcc ; return (usg', b_occ `combineOcc` scrut_occ, Alt con bs2 rhs') } ===================================== compiler/GHC/Driver/Config/Core/Opt/Simplify.hs ===================================== @@ -2,6 +2,7 @@ module GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyExprOpts , initSimplifyOpts , initSimplMode + , initGentleSimplMode ) where import GHC.Prelude @@ -26,13 +27,12 @@ import GHC.Types.Var ( Var ) initSimplifyExprOpts :: DynFlags -> InteractiveContext -> SimplifyExprOpts initSimplifyExprOpts dflags ic = SimplifyExprOpts { se_fam_inst = snd $ ic_instances ic - - , se_mode = (initSimplMode dflags) { sm_names = ["GHCi"] - , sm_inline = False } - -- sm_inline: do not do any inlining, in case we expose - -- some unboxed tuple stuff that confuses the bytecode + , se_mode = (initSimplMode dflags InitialPhase "GHCi") + { sm_inline = False + -- Do not do any inlining, in case we expose some + -- unboxed tuple stuff that confuses the bytecode -- interpreter - + } , se_top_env_cfg = TopEnvConfig { te_history_size = historySize dflags , te_tick_factor = simplTickFactor dflags @@ -56,25 +56,31 @@ initSimplifyOpts dflags extra_vars iterations mode hpt_rule_base = let } in opts -initSimplMode :: DynFlags -> SimplMode -initSimplMode dflags = SimplMode - { sm_names = ["Unknown simplifier run"] -- Always overriden - , sm_phase = InitialPhase - , sm_rules = gopt Opt_EnableRewriteRules dflags - , sm_eta_expand = gopt Opt_DoLambdaEtaExpansion dflags - , sm_pre_inline = gopt Opt_SimplPreInlining dflags - , sm_do_eta_reduction = gopt Opt_DoEtaReduction dflags - , sm_uf_opts = unfoldingOpts dflags - , sm_float_enable = floatEnable dflags - , sm_arity_opts = initArityOpts dflags - , sm_rule_opts = initRuleOpts dflags - , sm_case_folding = gopt Opt_CaseFolding dflags - , sm_case_merge = gopt Opt_CaseMerge dflags - , sm_co_opt_opts = initOptCoercionOpts dflags +initSimplMode :: DynFlags -> CompilerPhase -> String -> SimplMode +initSimplMode dflags phase name = SimplMode + { sm_names = [name] + , sm_phase = phase + , sm_rules = gopt Opt_EnableRewriteRules dflags + , sm_eta_expand = gopt Opt_DoLambdaEtaExpansion dflags , sm_cast_swizzle = True - , sm_inline = True - , sm_case_case = True - , sm_keep_exits = False + , sm_inline = True + , sm_uf_opts = unfoldingOpts dflags + , sm_case_case = True + , sm_pre_inline = gopt Opt_SimplPreInlining dflags + , sm_float_enable = floatEnable dflags + , sm_do_eta_reduction = gopt Opt_DoEtaReduction dflags + , sm_arity_opts = initArityOpts dflags + , sm_rule_opts = initRuleOpts dflags + , sm_case_folding = gopt Opt_CaseFolding dflags + , sm_case_merge = gopt Opt_CaseMerge dflags + , sm_co_opt_opts = initOptCoercionOpts dflags + } + +initGentleSimplMode :: DynFlags -> SimplMode +initGentleSimplMode dflags = (initSimplMode dflags InitialPhase "Gentle") + { -- Don't do case-of-case transformations. + -- This makes full laziness work better + sm_case_case = False } floatEnable :: DynFlags -> FloatEnable ===================================== testsuite/tests/simplCore/should_compile/T21148.hs deleted ===================================== @@ -1,12 +0,0 @@ -module T211148 where - --- The point of this test is that f should get a (nested) --- CPR property, with a worker of type --- $wf :: Int# -> State# RealWorld -> (# State# RealWorld, Int# #) - -{-# NOINLINE f #-} --- The NOINLINE makes GHC do a worker/wrapper split --- even though f is small -f :: Int -> IO Int -f x = return $! sum [0..x] - ===================================== testsuite/tests/simplCore/should_compile/T21148.stderr deleted ===================================== @@ -1,126 +0,0 @@ - -==================== Tidy Core ==================== -Result size of Tidy Core - = {terms: 73, types: 80, coercions: 6, joins: 2/2} - --- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule4 :: GHC.Prim.Addr# -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] -T211148.$trModule4 = "main"# - --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule3 :: GHC.Types.TrName -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -T211148.$trModule3 = GHC.Types.TrNameS T211148.$trModule4 - --- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule2 :: GHC.Prim.Addr# -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] -T211148.$trModule2 = "T211148"# - --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule1 :: GHC.Types.TrName -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -T211148.$trModule1 = GHC.Types.TrNameS T211148.$trModule2 - --- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule :: GHC.Types.Module -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -T211148.$trModule - = GHC.Types.Module T211148.$trModule3 T211148.$trModule1 - --- RHS size: {terms: 41, types: 35, coercions: 0, joins: 2/2} -T211148.$wf [InlPrag=NOINLINE] - :: GHC.Prim.Int# - -> GHC.Prim.State# GHC.Prim.RealWorld - -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #) -[GblId, Arity=2, Str=, Unf=OtherCon []] -T211148.$wf - = \ (ww_s179 :: GHC.Prim.Int#) - (eta_s17b [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld) -> - case GHC.Prim.># 0# ww_s179 of { - __DEFAULT -> - join { - exit_X0 [Dmd=SC(S,C(1,!P(L,L)))] - :: GHC.Prim.Int# - -> GHC.Prim.Int# - -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #) - [LclId[JoinId(2)(Nothing)], Arity=2, Str=] - exit_X0 (x_s16Z [OS=OneShot] :: GHC.Prim.Int#) - (ww1_s172 [OS=OneShot] :: GHC.Prim.Int#) - = (# eta_s17b, GHC.Prim.+# ww1_s172 x_s16Z #) } in - joinrec { - $wgo3_s175 [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,C(1,!P(L,L)))] - :: GHC.Prim.Int# - -> GHC.Prim.Int# - -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #) - [LclId[JoinId(2)(Nothing)], Arity=2, Str=, Unf=OtherCon []] - $wgo3_s175 (x_s16Z :: GHC.Prim.Int#) (ww1_s172 :: GHC.Prim.Int#) - = case GHC.Prim.==# x_s16Z ww_s179 of { - __DEFAULT -> - jump $wgo3_s175 - (GHC.Prim.+# x_s16Z 1#) (GHC.Prim.+# ww1_s172 x_s16Z); - 1# -> jump exit_X0 x_s16Z ww1_s172 - }; } in - jump $wgo3_s175 0# 0#; - 1# -> (# eta_s17b, 0# #) - } - --- RHS size: {terms: 14, types: 19, coercions: 0, joins: 0/0} -T211148.f1 [InlPrag=NOINLINE[final]] - :: Int - -> GHC.Prim.State# GHC.Prim.RealWorld - -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #) -[GblId, - Arity=2, - Str=<1!P(L)>, - Cpr=1(, 1), - Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (x_s177 [Occ=Once1!] :: Int) - (eta_s17b [Occ=Once1, OS=OneShot] - :: GHC.Prim.State# GHC.Prim.RealWorld) -> - case x_s177 of { GHC.Types.I# ww_s179 [Occ=Once1] -> - case T211148.$wf ww_s179 eta_s17b of - { (# ww1_s17e [Occ=Once1], ww2_s17j [Occ=Once1] #) -> - (# ww1_s17e, GHC.Types.I# ww2_s17j #) - } - }}] -T211148.f1 - = \ (x_s177 :: Int) - (eta_s17b [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld) -> - case x_s177 of { GHC.Types.I# ww_s179 -> - case T211148.$wf ww_s179 eta_s17b of { (# ww1_s17e, ww2_s17j #) -> - (# ww1_s17e, GHC.Types.I# ww2_s17j #) - } - } - --- RHS size: {terms: 1, types: 0, coercions: 6, joins: 0/0} -f [InlPrag=NOINLINE[final]] :: Int -> IO Int -[GblId, - Arity=2, - Str=<1!P(L)>, - Cpr=1(, 1), - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}] -f = T211148.f1 - `cast` (_R %<'Many>_N ->_R Sym (GHC.Types.N:IO[0] _R) - :: (Int - -> GHC.Prim.State# GHC.Prim.RealWorld - -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)) - ~R# (Int -> IO Int)) - - - ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -429,7 +429,6 @@ test('T21763a', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) test('T22028', normal, compile, ['-O -ddump-rule-firings']) test('T22114', normal, compile, ['-O']) test('T21286', normal, multimod_compile, ['T21286', '-O -ddump-rule-firings']) -test('T21148', [grep_errmsg(r'Cpr=') ], compile, ['-O -ddump-simpl']) # One module, T21851.hs, has OPTIONS_GHC -ddump-simpl test('T21851', [grep_errmsg(r'case.*w\$sf') ], multimod_compile, ['T21851', '-O -dno-typeable-binds -dsuppress-uniques']) ===================================== testsuite/tests/stranal/should_compile/T21128.hs ===================================== @@ -2,10 +2,6 @@ module T21128 where import T21128a -{- This test originally had some unnecessary reboxing of y -in the hot path of $wtheresCrud. That reboxing should -not happen. -} - theresCrud :: Int -> Int -> Int theresCrud x y = go x where @@ -13,4 +9,3 @@ theresCrud x y = go x go 1 = index x y 1 go n = go (n-1) {-# NOINLINE theresCrud #-} - ===================================== testsuite/tests/stranal/should_compile/T21128.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 125, types: 68, coercions: 4, joins: 0/0} + = {terms: 137, types: 92, coercions: 4, joins: 0/0} lvl = "error"# @@ -29,11 +29,17 @@ lvl9 = SrcLoc lvl2 lvl3 lvl5 lvl6 lvl7 lvl6 lvl8 lvl10 = PushCallStack lvl1 lvl9 EmptyCallStack +$windexError + = \ @a @b ww eta eta1 eta2 -> + error + (lvl10 `cast` :: CallStack ~R# (?callStack::CallStack)) + (++ (ww eta) (++ (ww eta1) (ww eta2))) + indexError = \ @a @b $dShow eta eta1 eta2 -> - error - (lvl10 `cast` :: ...) - (++ (show $dShow eta) (++ (show $dShow eta1) (show $dShow eta2))) + case $dShow of { C:Show ww ww1 ww2 -> + $windexError ww1 eta eta1 eta2 + } $trModule3 = TrNameS $trModule4 @@ -42,7 +48,8 @@ $trModule1 = TrNameS $trModule2 $trModule = Module $trModule3 $trModule1 $wlvl - = \ ww ww1 ww2 -> indexError $fShowInt (I# ww2) (I# ww1) (I# ww) + = \ ww ww1 ww2 -> + $windexError $fShowInt_$cshow (I# ww2) (I# ww1) (I# ww) index = \ l u i -> @@ -66,7 +73,7 @@ index ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 108, types: 46, coercions: 0, joins: 3/3} + = {terms: 108, types: 47, coercions: 0, joins: 3/4} $trModule4 = "main"# @@ -82,34 +89,35 @@ i = I# 1# l = I# 0# -lvl = \ x ww -> indexError $fShowInt x (I# ww) i +lvl = \ y -> $windexError $fShowInt_$cshow l y l -lvl1 = \ ww -> indexError $fShowInt l (I# ww) l +lvl1 = \ ww y -> $windexError $fShowInt_$cshow (I# ww) y i $wtheresCrud = \ ww ww1 -> + let { y = I# ww1 } in join { - exit - = case <# 0# ww1 of { - __DEFAULT -> case lvl1 ww1 of wild { }; - 1# -> 0# - } } in - join { - exit1 + lvl2 = case <=# ww 1# of { - __DEFAULT -> case lvl (I# ww) ww1 of wild { }; + __DEFAULT -> case lvl1 ww y of wild { }; 1# -> case <# 1# ww1 of { - __DEFAULT -> case lvl (I# ww) ww1 of wild { }; + __DEFAULT -> case lvl1 ww y of wild { }; 1# -> -# 1# ww } } } in + join { + lvl3 + = case <# 0# ww1 of { + __DEFAULT -> case lvl y of wild { }; + 1# -> 0# + } } in joinrec { $wgo ww2 = case ww2 of wild { __DEFAULT -> jump $wgo (-# wild 1#); - 0# -> jump exit; - 1# -> jump exit1 + 0# -> jump lvl3; + 1# -> jump lvl2 }; } in jump $wgo ww View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ff9e4063e59ae9a76d1911d7a9194065d40d5e2f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ff9e4063e59ae9a76d1911d7a9194065d40d5e2f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 19:11:59 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 07 Feb 2023 14:11:59 -0500 Subject: [Git][ghc/ghc][wip/T22264] 132 commits: Do newtype unwrapping in the canonicaliser and rewriter Message-ID: <63e2a27fecc83_1108fe5264818072b5@gitlab.mail> Ben Gamari pushed to branch wip/T22264 at Glasgow Haskell Compiler / GHC Commits: 3e827c3f by Richard Eisenberg at 2023-01-26T20:06:53-05:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. - - - - - b3ef5c89 by doyougnu at 2023-01-26T20:07:48-05:00 tryFillBuffer: strictify more speculative bangs - - - - - d0d7ba0f by Vladislav Zavialov at 2023-01-26T20:08:25-05:00 base: NoImplicitPrelude in Data.Void and Data.Kind This change removes an unnecessary dependency on Prelude from two modules in the base package. - - - - - fa1db923 by Matthew Pickering at 2023-01-26T20:09:00-05: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 - - - - - 807310a1 by Matthew Pickering at 2023-01-26T20:09:00-05:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. - - - - - c7116b10 by Ben Gamari at 2023-01-26T20:09:35-05:00 base: Make changelog proposal references more consistent Addresses #22773. - - - - - 6932cfc7 by Sylvain Henry at 2023-01-26T20:10:27-05:00 Fix spurious change from !9568 - - - - - e480fbc2 by Ben Gamari at 2023-01-27T05:01:24-05:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 - - - - - 2648c09c by Andrei Borzenkov at 2023-01-27T05:02:07-05:00 Replace errors from badOrigBinding with new one (#22839) Problem: in 02279a9c the type-level [] syntax was changed from a built-in name to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if a name is not built-in then it must have come from TH quotation, but this is not necessarily the case with []. The outdated assumption in badOrigBinding leads to incorrect error messages. This code: data [] Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []" Unfortunately, there is not enough information in RdrName to directly determine if the name was constructed via TH or by the parser, so this patch changes the error message instead. It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote into a new error TcRnBindingOfExistingName and changes its wording to avoid guessing the origin of the name. - - - - - 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - c8db494d by Ben Gamari at 2023-02-07T13:44:19-05:00 nonmoving: Fix style - - - - - 1a509f81 by Ben Gamari at 2023-02-07T13:44:19-05:00 nonmoving: Deduplicate assertion - - - - - f1297a0b by Ben Gamari at 2023-02-07T13:44:19-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - 67e2f525 by Ben Gamari at 2023-02-07T13:44:19-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 5c99b61c by Ben Gamari at 2023-02-07T13:44:19-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 8c6c8bf1 by Ben Gamari at 2023-02-07T13:44:19-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 6af9b2b1 by Ben Gamari at 2023-02-07T13:44:19-05:00 Evac: Squash data race in eval_selector_chain - - - - - 66c16cc0 by Ben Gamari at 2023-02-07T13:44:19-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - ee733703 by Ben Gamari at 2023-02-07T13:44:19-05:00 nonmoving: Clarify comment - - - - - f0f1be55 by Ben Gamari at 2023-02-07T13:44:19-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - 448918c6 by Ben Gamari at 2023-02-07T13:53:12-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - b299f4e9 by Ben Gamari at 2023-02-07T13:53:36-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ce76a341 by Ben Gamari at 2023-02-07T13:53:45-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 702cb8fd by Ben Gamari at 2023-02-07T13:53:45-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - b374935d by Ben Gamari at 2023-02-07T13:53:45-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - a29a2a22 by Ben Gamari at 2023-02-07T13:53:45-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 521774e8 by Ben Gamari at 2023-02-07T13:53:45-05:00 nonmoving: Assert state of swept segments - - - - - cabde834 by Ben Gamari at 2023-02-07T14:09:18-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - 6bda7b1d by Ben Gamari at 2023-02-07T14:10:43-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 968ca526 by Ben Gamari at 2023-02-07T14:10:43-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - 2b8d1d04 by Ben Gamari at 2023-02-07T14:10:43-05:00 nonmoving: Post-sweep sanity checking - - - - - d4053620 by Ben Gamari at 2023-02-07T14:10:43-05:00 nonmoving: Avoid n_caps race - - - - - 6455438a by Ben Gamari at 2023-02-07T14:10:43-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 6852666d by Ben Gamari at 2023-02-07T14:10:43-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 99e6e4f8 by Ben Gamari at 2023-02-07T14:10:43-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - 2c98711d by Ben Gamari at 2023-02-07T14:10:44-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 0140ee6f by Ben Gamari at 2023-02-07T14:10:44-05:00 rts: Reenable assertion - - - - - de03ec5f by Ben Gamari at 2023-02-07T14:10:44-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 45e2a880 by Ben Gamari at 2023-02-07T14:10:44-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 701d6a21 by Ben Gamari at 2023-02-07T14:10:44-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 49bb25d7 by Ben Gamari at 2023-02-07T14:10:44-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 3ba5d284 by Ben Gamari at 2023-02-07T14:10:44-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - e7e2e3ac by Ben Gamari at 2023-02-07T14:10:44-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 8a71564e by Ben Gamari at 2023-02-07T14:10:44-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - a2641a18 by Ben Gamari at 2023-02-07T14:10:44-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - be658e96 by Ben Gamari at 2023-02-07T14:10:44-05:00 nonmoving: Fix unregisterised build - - - - - 4bca12b0 by Ben Gamari at 2023-02-07T14:10:44-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - cabal.project-reinstall - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Reg.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/BlockLayout.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b05a228ebcfb8914fba1a2ec02ceb05b310738c9...4bca12b0355b844d40aacbf85705bcd6e2923175 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b05a228ebcfb8914fba1a2ec02ceb05b310738c9...4bca12b0355b844d40aacbf85705bcd6e2923175 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 19:14:23 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 07 Feb 2023 14:14:23 -0500 Subject: [Git][ghc/ghc][wip/T22264] 3 commits: testsuite: Skip some tests when sanity checking is enabled Message-ID: <63e2a30f4e4a0_1108fe5263418078f0@gitlab.mail> Ben Gamari pushed to branch wip/T22264 at Glasgow Haskell Compiler / GHC Commits: afd95331 by Ben Gamari at 2023-02-07T14:14:17-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - cb654e09 by Ben Gamari at 2023-02-07T14:14:17-05:00 nonmoving: Fix unregisterised build - - - - - df51737c by Ben Gamari at 2023-02-07T14:14:17-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 7 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - libraries/ghc-heap/tests/all.T - rts/sm/NonMoving.h - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/perf/space_leaks/all.T - testsuite/tests/rts/all.T Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -646,7 +646,6 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } , "bash .gitlab/ci.sh test_hadrian" ] | otherwise = [ "find libraries -name config.sub -exec cp config.sub {} \\;" | Darwin == opsys ] ++ - [ "sudo apk del --purge glibc*" | opsys == Linux Alpine, isNothing $ crossTarget buildConfig ] ++ [ "sudo chown ghc:ghc -R ." | Linux {} <- [opsys]] ++ [ ".gitlab/ci.sh setup" , ".gitlab/ci.sh configure" ===================================== .gitlab/jobs.yaml ===================================== @@ -706,7 +706,6 @@ } ], "script": [ - "sudo apk del --purge glibc*", "sudo chown ghc:ghc -R .", ".gitlab/ci.sh setup", ".gitlab/ci.sh configure", @@ -830,7 +829,6 @@ } ], "script": [ - "sudo apk del --purge glibc*", "sudo chown ghc:ghc -R .", ".gitlab/ci.sh setup", ".gitlab/ci.sh configure", @@ -2459,7 +2457,6 @@ } ], "script": [ - "sudo apk del --purge glibc*", "sudo chown ghc:ghc -R .", ".gitlab/ci.sh setup", ".gitlab/ci.sh configure", @@ -2523,7 +2520,6 @@ } ], "script": [ - "sudo apk del --purge glibc*", "sudo chown ghc:ghc -R .", ".gitlab/ci.sh setup", ".gitlab/ci.sh configure", @@ -3621,7 +3617,6 @@ } ], "script": [ - "sudo apk del --purge glibc*", "sudo chown ghc:ghc -R .", ".gitlab/ci.sh setup", ".gitlab/ci.sh configure", ===================================== libraries/ghc-heap/tests/all.T ===================================== @@ -5,7 +5,8 @@ test('heap_all', # These ways produce slightly different heap representations. # Currently we don't test them. omit_ways(['ghci', 'hpc', - 'nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc']), + 'nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc', + 'nonmoving_thr_sanity']), # The debug RTS initializes some fields with 0xaa and so # this test spuriously fails. when(compiler_debugged(), skip) ===================================== rts/sm/NonMoving.h ===================================== @@ -341,10 +341,14 @@ INLINE_HEADER bool nonmovingClosureBeingSwept(StgClosure *p) } } +// N.B. RtsFlags is defined as a pointer in STG code consequently this code +// doesn't typecheck. +#if !IN_STG_CODE INLINE_HEADER bool isNonmovingClosure(StgClosure *p) { return RtsFlags.GcFlags.useNonmoving && (!HEAP_ALLOCED_GC(p) || Bdescr((P_)p)->flags & BF_NONMOVING); } +#endif #if defined(DEBUG) ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -203,7 +203,7 @@ test('T15696_3', normal, compile_and_run, ['-O']) test('T15892', [ ignore_stdout, # -G1 is unsupported by the nonmoving GC - omit_ways(['nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc']), + omit_ways(['nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc', 'nonmoving_thr_sanity']), # we want to do lots of major GC to make the bug more likely to # happen, so -G1 -A32k: extra_run_opts('+RTS -G1 -A32k -RTS') ], ===================================== testsuite/tests/perf/space_leaks/all.T ===================================== @@ -6,7 +6,8 @@ test('space_leak_001', # 5% possible deviation. [ collect_stats('bytes allocated',5), collect_runtime_residency(15), - omit_ways(['profasm','profthreaded','threaded1','threaded2','nonmoving_thr']) + omit_ways(['profasm','profthreaded','threaded1','threaded2', + 'nonmoving_thr', 'nonmoving_thr_sanity']) ], compile_and_run, ['']) @@ -17,7 +18,7 @@ test('T4334', collect_runtime_residency(2), # prof ways don't work well with +RTS -V0, nonmoving way residency is # highly variable. - omit_ways(['profasm','profthreaded','nonmoving_thr']) + omit_ways(['profasm','profthreaded','nonmoving_thr', 'nonmoving_thr_sanity']) ], compile_and_run, ['']) ===================================== testsuite/tests/rts/all.T ===================================== @@ -110,7 +110,7 @@ test('T2047', [ignore_stdout, extra_run_opts('+RTS -c -RTS'), # Non-moving collector doesn't support -c - omit_ways(['nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc'])], + omit_ways(['nonmoving', 'nonmoving_thr', 'nonmoving_thr_sanity', 'nonmoving_thr_ghc'])], compile_and_run, ['-package containers']) # Blackhole-detection test. @@ -261,7 +261,8 @@ test('T6006', [ omit_ways(prof_ways + ['ghci']), test('T7037', js_broken(22374), makefile_test, ['T7037']) test('T7087', exit_code(1), compile_and_run, ['']) -test('T7160', [ omit_ways(['nonmoving_thr', 'nonmoving_thr_ghc']) +test('T7160', [ # finalization order is too nondeterministic in the concurrent GC + omit_ways(['nonmoving_thr', 'nonmoving_thr_ghc', 'nonmoving_thr_sanity']) , js_broken(22261) ], compile_and_run, ['']) @@ -450,6 +451,9 @@ test('T14900', test('InternalCounters', [ js_skip # JS backend doesn't support internal counters + # The ways which build against the debug RTS are built with PROF_SPIN and + # therefore differ in output + , omit_ways(['nonmoving_thr_sanity', 'threaded2_sanity', 'sanity']) ], makefile_test, ['InternalCounters']) test('alloccounter1', js_broken(22261), compile_and_run, [ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4bca12b0355b844d40aacbf85705bcd6e2923175...df51737ca3b07794d9844fa95689305a75cbad74 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4bca12b0355b844d40aacbf85705bcd6e2923175...df51737ca3b07794d9844fa95689305a75cbad74 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 19:26:45 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 07 Feb 2023 14:26:45 -0500 Subject: [Git][ghc/ghc][wip/T22264-9.2] 16 commits: Evac: Squash data race in eval_selector_chain Message-ID: <63e2a5f5db97f_1108fe6969b2e818152ea@gitlab.mail> Ben Gamari pushed to branch wip/T22264-9.2 at Glasgow Haskell Compiler / GHC Commits: 3a419e93 by Ben Gamari at 2023-02-07T13:24:30-05:00 Evac: Squash data race in eval_selector_chain (cherry picked from commit dd784b3b01f076fa7f5715150c53ad4c183ae79d) - - - - - c3a92bf1 by Ben Gamari at 2023-02-07T13:24:32-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Likely fixes the cause of #22264. (cherry picked from commit f8988a9c53ae73ff5b9c6008f467a7171e99c61f) - - - - - 3419e4a9 by Ben Gamari at 2023-02-07T13:24:32-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. (cherry picked from commit a999f7b5b4b7316c088d7233a452fb33dc17646f) - - - - - 8d38cc72 by Ben Gamari at 2023-02-07T13:24:32-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. (cherry picked from commit 48b89dba91640fa977d038ea5283019c73f1b18e) - - - - - 7ae5d279 by Ben Gamari at 2023-02-07T13:24:32-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive (cherry picked from commit 36ca160d0f199a688cf5fbc91d4bb92d2d4ea14e) - - - - - afd442cd by Ben Gamari at 2023-02-07T13:24:32-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. (cherry picked from commit 8b64aff0fa978c762dfae8df235dd2b2a340656a) - - - - - fb609089 by Ben Gamari at 2023-02-07T13:25:17-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. (cherry picked from commit dde67d6e32ecff0e400f98213d42ae790babac09) - - - - - 5683d1aa by Ben Gamari at 2023-02-07T13:25:18-05:00 nonmoving: Don't push if nonmoving collector isn't enabled (cherry picked from commit 8adc1750c02e596b4014d2837b4eb3d76bd130f2) - - - - - 9608ad9e by Ben Gamari at 2023-02-07T13:28:33-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. (cherry picked from commit c620669651c52fd228af61040747dd7236c4ba2b) - - - - - e11beaef by Ben Gamari at 2023-02-07T13:28:33-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys (cherry picked from commit 3887132fcd20f0a1edfc9f7006bdbed2634e2a8d) - - - - - 91b59c37 by Ben Gamari at 2023-02-07T13:28:33-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. (cherry picked from commit cc75031b4d93d4565e0428cb5910d9b9a645485b) - - - - - b66a3fac by Ben Gamari at 2023-02-07T13:28:33-05:00 nonmoving: Add missing no-op in busy-wait loop (cherry picked from commit 9f931a8801c84b8ae473f91349e144eebc73b415) - - - - - bfc28f9e by Ben Gamari at 2023-02-07T13:28:33-05:00 nonmoving: Move current segment array into Capability (cherry picked from commit 9d245c1baec91ee79d715062b127e487456d9c9e) - - - - - fb29d24e by Ben Gamari at 2023-02-07T13:28:33-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. (cherry picked from commit 6bdce35cdd59112a8cb4a4a3b061e854ada3ff63) - - - - - cc33f536 by Ben Gamari at 2023-02-07T13:28:33-05:00 nonmoving: Fix unregisterised build (cherry picked from commit 6df2709e7215ea80d7267800e0318aee2a7c277f) - - - - - cfb775f0 by Ben Gamari at 2023-02-07T13:28:33-05:00 nonmoving: Avoid n_caps race (cherry picked from commit c00d6de815d4e125c1c4d8ff06549042f502f759) - - - - - 16 changed files: - rts/Capability.c - rts/Capability.h - rts/PrimOps.cmm - rts/RtsStartup.c - rts/Schedule.c - rts/sm/Evac.c - rts/sm/GC.c - rts/sm/MarkWeak.c - rts/sm/NonMoving.c - rts/sm/NonMoving.h - rts/sm/NonMovingCensus.c - rts/sm/NonMovingCensus.h - rts/sm/NonMovingMark.c - rts/sm/NonMovingMark.h - rts/sm/Sanity.c - rts/sm/Storage.c Changes: ===================================== rts/Capability.c ===================================== @@ -294,6 +294,7 @@ initCapability (Capability *cap, uint32_t i) cap->saved_mut_lists = stgMallocBytes(sizeof(bdescr *) * RtsFlags.GcFlags.generations, "initCapability"); + cap->current_segments = NULL; // At this point storage manager is not initialized yet, so this will be @@ -1267,6 +1268,9 @@ freeCapability (Capability *cap) { stgFree(cap->mut_lists); stgFree(cap->saved_mut_lists); + if (cap->current_segments) { + stgFree(cap->current_segments); + } #if defined(THREADED_RTS) freeSparkPool(cap->sparks); #endif ===================================== rts/Capability.h ===================================== @@ -88,6 +88,9 @@ struct Capability_ { // The update remembered set for the non-moving collector UpdRemSet upd_rem_set; + // Array of current segments for the non-moving collector. + // Of length NONMOVING_ALLOCA_CNT. + struct NonmovingSegment **current_segments; // block for allocating pinned objects into bdescr *pinned_object_block; ===================================== rts/PrimOps.cmm ===================================== @@ -234,9 +234,9 @@ stg_shrinkSmallMutableArrayzh ( gcptr mba, W_ new_size ) p = mba + SIZEOF_StgSmallMutArrPtrs + WDS(new_size); end = mba + SIZEOF_StgSmallMutArrPtrs + WDS(StgSmallMutArrPtrs_ptrs(mba)); again: - ccall updateRemembSetPushClosure_(BaseReg "ptr", - W_[p] "ptr"); if (p < end) { + ccall updateRemembSetPushClosure_(BaseReg "ptr", + W_[p] "ptr"); p = p + SIZEOF_W; goto again; } ===================================== rts/RtsStartup.c ===================================== @@ -472,6 +472,7 @@ hs_exit_(bool wait_foreign) for (g = 0; g < RtsFlags.GcFlags.generations; g++) { runAllCFinalizers(generations[g].weak_ptr_list); } + runAllCFinalizers(nonmoving_weak_ptr_list); #if defined(RTS_USER_SIGNALS) if (RtsFlags.MiscFlags.install_signal_handlers) { ===================================== rts/Schedule.c ===================================== @@ -2306,7 +2306,9 @@ setNumCapabilities (uint32_t new_n_capabilities USED_IF_THREADS) moreCapabilities(n_capabilities, new_n_capabilities); // Resize and update storage manager data structures + ACQUIRE_SM_LOCK; storageAddCapabilities(n_capabilities, new_n_capabilities); + RELEASE_SM_LOCK; } } ===================================== rts/sm/Evac.c ===================================== @@ -1251,8 +1251,13 @@ selector_chain: // save any space in any case, and updating with an indirection is // trickier in a non-collected gen: we would have to update the // mutable list. - if (RELAXED_LOAD(&bd->flags) & (BF_EVACUATED | BF_NONMOVING)) { + uint16_t flags = RELAXED_LOAD(&bd->flags); + if (flags & (BF_EVACUATED | BF_NONMOVING)) { unchain_thunk_selectors(prev_thunk_selector, (StgClosure *)p); + if (flags & BF_NONMOVING) { + // See Note [Non-moving GC: Marking evacuated objects]. + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure*) p); + } *q = (StgClosure *)p; // shortcut, behave as for: if (evac) evacuate(q); if (evac && bd->gen_no < gct->evac_gen_no) { @@ -1267,7 +1272,7 @@ selector_chain: // (scavenge_mark_stack doesn't deal with IND). BEWARE! This // bit is very tricky to get right. If you make changes // around here, test by compiling stage 3 with +RTS -c -RTS. - if (bd->flags & BF_MARKED) { + if (flags & BF_MARKED) { // must call evacuate() to mark this closure if evac==true *q = (StgClosure *)p; if (evac) evacuate(q); @@ -1307,6 +1312,12 @@ selector_chain: // - undo the chain we've built to point to p. SET_INFO((StgClosure *)p, (const StgInfoTable *)info_ptr); RELEASE_STORE(q, (StgClosure *) p); + if (Bdescr((StgPtr)p)->flags & BF_NONMOVING) { + // See Note [Non-moving GC: Marking evacuated objects]. + // TODO: This really shouldn't be necessary since whoever won + // the race should have pushed + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure*) p); + } if (evac) evacuate(q); unchain_thunk_selectors(prev_thunk_selector, (StgClosure *)p); return; @@ -1397,6 +1408,11 @@ selector_loop: case THUNK_SELECTOR: // Use payload to make a list of thunk selectors, to be // used in unchain_thunk_selectors + // + // FIXME: This seems racy; should we lock this selector to + // ensure that another thread doesn't clobber this node + // of the chain. This would result in some previous + // selectors not being updated when we unchain. RELAXED_STORE(&((StgClosure*)p)->payload[0], (StgClosure *)prev_thunk_selector); prev_thunk_selector = p; p = (StgSelector*)val; @@ -1421,6 +1437,12 @@ selector_loop: // eval_thunk_selector(), because we know val is not // a THUNK_SELECTOR. if (evac) evacuate(q); + + if (isNonmovingClosure(*q)) { + // See Note [Non-moving GC: Marking evacuated objects]. + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure*) *q); + } + return; } @@ -1465,6 +1487,10 @@ selector_loop: // recurse indefinitely, so we impose a depth bound. // See Note [Selector optimisation depth limit]. if (gct->thunk_selector_depth >= MAX_THUNK_SELECTOR_DEPTH) { + if (isNonmovingClosure((StgClosure *) p)) { + // See Note [Non-moving GC: Marking evacuated objects]. + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure*) p); + } goto bale_out; } @@ -1511,5 +1537,9 @@ bale_out: if (evac) { copy(q,(const StgInfoTable *)info_ptr,(StgClosure *)p,THUNK_SELECTOR_sizeW(),bd->dest_no); } + if (isNonmovingClosure(*q)) { + // See Note [Non-moving GC: Marking evacuated objects]. + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, *q); + } unchain_thunk_selectors(prev_thunk_selector, *q); } ===================================== rts/sm/GC.c ===================================== @@ -375,7 +375,8 @@ GarbageCollect (uint32_t collect_gen, static_flag == STATIC_FLAG_A ? STATIC_FLAG_B : STATIC_FLAG_A; } - if (major_gc) { + /* N.B. We currently don't unload code with the non-moving collector. */ + if (major_gc && !RtsFlags.GcFlags.useNonmoving) { unload_mark_needed = prepareUnloadCheck(); } else { unload_mark_needed = false; ===================================== rts/sm/MarkWeak.c ===================================== @@ -50,7 +50,7 @@ - weak_stage == WeakPtrs - We process all the weak pointers whos keys are alive (evacuate + We process all the weak pointers whose keys are alive (evacuate their values and finalizers), and repeat until we can find no new live keys. If no live keys are found in this pass, then we evacuate the finalizers of all the dead weak pointers in order to @@ -82,12 +82,46 @@ static bool tidyWeakList (generation *gen); static bool resurrectUnreachableThreads (generation *gen, StgTSO **resurrected_threads); static void tidyThreadList (generation *gen); +/* + * Note [Weak pointer processing and the non-moving GC] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * When using the non-moving GC we defer weak pointer processing + * until the concurrent marking phase as weaks in the non-moving heap may be + * keyed on objects living in the non-moving generation. To accomplish this + * initWeakForGC keeps all weak pointers on oldest_gen->weak_ptr_list, where + * nonmovingCollect will find them. From there they will be moved to + * nonmoving_old_weak_ptr_list. During the mark loop we will move weaks with + * reachable keys to nonmoving_weak_ptr_list. At the end of concurrent marking + * we tidy the weak list (in nonmovingTidyWeakList) and perform another set of + * marking as necessary, just as is done in tidyWeakList. + * + * Note that this treatment takes advantage of the fact that we usually need + * not worry about Weak#s living in the non-moving heap but being keyed on an + * object in the moving heap since the Weak# must be strictly older than the + * key. Such objects would otherwise pose a problem since the non-moving + * collector would be unable to safely determine the liveness of the key. + * In the rare case that we *do* see such a key (e.g. in the case of a + * pinned ByteArray# living in a partially-filled accumulator block) + * the nonmoving collector assumes that it is live. + * + */ + +/* + * Prepare the weak object lists for GC. Specifically, reset weak_stage + * and move all generations' `weak_ptr_list`s to `old_weak_ptr_list`. + * Weaks with live keys will later be moved back to `weak_ptr_list` by + * `tidyWeakList`. + */ void initWeakForGC(void) { - uint32_t g; + uint32_t oldest = N; + if (RtsFlags.GcFlags.useNonmoving && N == oldest_gen->no) { + // See Note [Weak pointer processing and the non-moving GC]. + oldest = oldest_gen->no - 1; + } - for (g = 0; g <= N; g++) { + for (uint32_t g = 0; g <= oldest; g++) { generation *gen = &generations[g]; gen->old_weak_ptr_list = gen->weak_ptr_list; gen->weak_ptr_list = NULL; @@ -96,6 +130,14 @@ initWeakForGC(void) weak_stage = WeakThreads; } +/* + * Walk the weak pointer lists after having finished a round of scavenging, + * tidying the weak (and possibly thread) lists (depending upon the current + * weak_stage). + * + * Returns true if new live weak pointers were found, implying that another + * round of scavenging is necessary. + */ bool traverseWeakPtrList(StgWeak **dead_weak_ptr_list, StgTSO **resurrected_threads) { @@ -182,6 +224,11 @@ traverseWeakPtrList(StgWeak **dead_weak_ptr_list, StgTSO **resurrected_threads) } } +/* + * Deal with weak pointers with unreachable keys after GC has concluded. + * This means marking the finalizer (and possibly value) in preparation for + * later finalization. + */ static void collectDeadWeakPtrs (generation *gen, StgWeak **dead_weak_ptr_list) { StgWeak *w, *next_w; @@ -198,6 +245,10 @@ static void collectDeadWeakPtrs (generation *gen, StgWeak **dead_weak_ptr_list) } } +/* + * Deal with threads left on the old_threads list after GC has concluded, + * moving them onto the resurrected_threads list where appropriate. + */ static bool resurrectUnreachableThreads (generation *gen, StgTSO **resurrected_threads) { StgTSO *t, *tmp, *next; @@ -233,8 +284,21 @@ static bool resurrectUnreachableThreads (generation *gen, StgTSO **resurrected_t return flag; } +/* + * Walk over the `old_weak_ptr_list` of the given generation and: + * + * - remove any DEAD_WEAKs + * - move any weaks with reachable keys to the `weak_ptr_list` of the + * appropriate to-space and mark the weak's value and finalizer. + */ static bool tidyWeakList(generation *gen) { + if (RtsFlags.GcFlags.useNonmoving && gen == oldest_gen) { + // See Note [Weak pointer processing and the non-moving GC]. + ASSERT(gen->old_weak_ptr_list == NULL); + return false; + } + StgWeak *w, **last_w, *next_w; const StgInfoTable *info; StgClosure *new; @@ -322,6 +386,10 @@ static bool tidyWeakList(generation *gen) return flag; } +/* + * Walk over the `old_threads` list of the given generation and move any + * reachable threads onto the `threads` list. + */ static void tidyThreadList (generation *gen) { StgTSO *t, *tmp, *next, **prev; @@ -381,6 +449,10 @@ static void checkWeakPtrSanity(StgWeak *hd, StgWeak *tl) } #endif +/* + * Traverse the capabilities' local new-weak-pointer lists at the beginning of + * GC and move them to the nursery's weak_ptr_list. + */ void collectFreshWeakPtrs() { uint32_t i; ===================================== rts/sm/NonMoving.c ===================================== @@ -244,6 +244,12 @@ Mutex concurrent_coll_finished_lock; * how we use the DIRTY flags associated with MUT_VARs and TVARs to improve * barrier efficiency. * + * - Note [Weak pointer processing and the non-moving GC] (MarkWeak.c) describes + * how weak pointers are handled when the non-moving GC is in use. + * + * - Note [Sync phase marking budget] describes how we avoid long mutator + * pauses during the sync phase + * * [ueno 2016]: * Katsuhiro Ueno and Atsushi Ohori. 2016. A fully concurrent garbage * collector for functional programs on multicore processors. SIGPLAN Not. 51, @@ -292,6 +298,7 @@ Mutex concurrent_coll_finished_lock; * ┆ * B ←────────────── A ←─────────────── root * │ ┆ ↖─────────────── gen1 mut_list + * │ ┆ * ╰───────────────→ C * ┆ * @@ -332,6 +339,7 @@ Mutex concurrent_coll_finished_lock; * The implementation details of this are described in Note [Non-moving GC: * Marking evacuated objects] in Evac.c. * + * * Note [Deadlock detection under the non-moving collector] * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ * In GHC the garbage collector is responsible for identifying deadlocked @@ -493,10 +501,44 @@ Mutex concurrent_coll_finished_lock; * remembered set during the preparatory GC. This allows us to safely skip the * non-moving write barrier without jeopardizing the snapshot invariant. * + * + * Note [Sync phase marking budget] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * The non-moving collector is intended to provide reliably low collection + * latencies. These latencies are primarily due to two sources: + * + * a. the preparatory moving collection at the beginning of the major GC cycle + * b. the post-mark synchronization pause at the end + * + * While the cost of (a) is inherently bounded by the young generation size, + * (b) can in principle be unbounded since the mutator may hide large swathes + * of heap from the collector's concurrent mark phase via mutation. These will + * only become visible to the collector during the post-mark synchronization + * phase. + * + * Since we don't want to do unbounded marking work in the pause, we impose a + * limit (specifically, sync_phase_marking_budget) on the amount of work + * (namely, the number of marked closures) that we can do during the pause. If + * we deplete our marking budget during the pause then we allow the mutators to + * resume and return to concurrent marking (keeping the update remembered set + * write barrier enabled). After we have finished marking we will again + * attempt the post-mark synchronization. + * + * The choice of sync_phase_marking_budget was made empirically. On 2022 + * hardware and a "typical" test program we tend to mark ~10^7 closures per + * second. Consequently, a sync_phase_marking_budget of 10^5 should produce + * ~10 ms pauses, which seems like a reasonable tradeoff. + * + * TODO: Perhaps sync_phase_marking_budget should be controllable via a + * command-line argument? + * */ memcount nonmoving_live_words = 0; +// See Note [Sync phase marking budget]. +MarkBudget sync_phase_marking_budget = 200000; + #if defined(THREADED_RTS) static void* nonmovingConcurrentMark(void *mark_queue); #endif @@ -665,10 +707,11 @@ void *nonmovingAllocate(Capability *cap, StgWord sz) // object and not moved) which is covered by allocator 9. ASSERT(log_block_size < NONMOVING_ALLOCA0 + NONMOVING_ALLOCA_CNT); - struct NonmovingAllocator *alloca = nonmovingHeap.allocators[log_block_size - NONMOVING_ALLOCA0]; + unsigned int alloca_idx = log_block_size - NONMOVING_ALLOCA0; + struct NonmovingAllocator *alloca = &nonmovingHeap.allocators[alloca_idx]; // Allocate into current segment - struct NonmovingSegment *current = alloca->current[cap->no]; + struct NonmovingSegment *current = cap->current_segments[alloca_idx]; ASSERT(current); // current is never NULL void *ret = nonmovingSegmentGetBlock_(current, log_block_size, current->next_free); ASSERT(GET_CLOSURE_TAG(ret) == 0); // check alignment @@ -701,29 +744,12 @@ void *nonmovingAllocate(Capability *cap, StgWord sz) // make it current new_current->link = NULL; SET_SEGMENT_STATE(new_current, CURRENT); - alloca->current[cap->no] = new_current; + cap->current_segments[alloca_idx] = new_current; } return ret; } -/* Allocate a nonmovingAllocator */ -static struct NonmovingAllocator *alloc_nonmoving_allocator(uint32_t n_caps) -{ - size_t allocator_sz = - sizeof(struct NonmovingAllocator) + - sizeof(void*) * n_caps; // current segment pointer for each capability - struct NonmovingAllocator *alloc = - stgMallocBytes(allocator_sz, "nonmovingInit"); - memset(alloc, 0, allocator_sz); - return alloc; -} - -static void free_nonmoving_allocator(struct NonmovingAllocator *alloc) -{ - stgFree(alloc); -} - void nonmovingInit(void) { if (! RtsFlags.GcFlags.useNonmoving) return; @@ -732,10 +758,7 @@ void nonmovingInit(void) initCondition(&concurrent_coll_finished); initMutex(&concurrent_coll_finished_lock); #endif - for (unsigned int i = 0; i < NONMOVING_ALLOCA_CNT; i++) { - nonmovingHeap.allocators[i] = alloc_nonmoving_allocator(getNumCapabilities()); - } - nonmovingMarkInitUpdRemSet(); + nonmovingMarkInit(); } // Stop any nonmoving collection in preparation for RTS shutdown. @@ -764,44 +787,24 @@ void nonmovingExit(void) closeCondition(&concurrent_coll_finished); closeMutex(&nonmoving_collection_mutex); #endif - - for (unsigned int i = 0; i < NONMOVING_ALLOCA_CNT; i++) { - free_nonmoving_allocator(nonmovingHeap.allocators[i]); - } } -/* - * Assumes that no garbage collector or mutator threads are running to safely - * resize the nonmoving_allocators. - * - * Must hold sm_mutex. - */ -void nonmovingAddCapabilities(uint32_t new_n_caps) +/* Initialize a new capability. Caller must hold SM_LOCK */ +void nonmovingInitCapability(Capability *cap) { - unsigned int old_n_caps = nonmovingHeap.n_caps; - struct NonmovingAllocator **allocs = nonmovingHeap.allocators; - + // Initialize current segment array + struct NonmovingSegment **segs = + stgMallocBytes(sizeof(struct NonmovingSegment*) * NONMOVING_ALLOCA_CNT, "current segment array"); for (unsigned int i = 0; i < NONMOVING_ALLOCA_CNT; i++) { - struct NonmovingAllocator *old = allocs[i]; - allocs[i] = alloc_nonmoving_allocator(new_n_caps); - - // Copy the old state - allocs[i]->filled = old->filled; - allocs[i]->active = old->active; - for (unsigned int j = 0; j < old_n_caps; j++) { - allocs[i]->current[j] = old->current[j]; - } - stgFree(old); - - // Initialize current segments for the new capabilities - for (unsigned int j = old_n_caps; j < new_n_caps; j++) { - allocs[i]->current[j] = nonmovingAllocSegment(capabilities[j]->node); - nonmovingInitSegment(allocs[i]->current[j], NONMOVING_ALLOCA0 + i); - SET_SEGMENT_STATE(allocs[i]->current[j], CURRENT); - allocs[i]->current[j]->link = NULL; - } + segs[i] = nonmovingAllocSegment(cap->node); + nonmovingInitSegment(segs[i], NONMOVING_ALLOCA0 + i); + SET_SEGMENT_STATE(segs[i], CURRENT); } - nonmovingHeap.n_caps = new_n_caps; + cap->current_segments = segs; + + // Initialize update remembered set + cap->upd_rem_set.queue.blocks = NULL; + nonmovingInitUpdRemSet(&cap->upd_rem_set); } void nonmovingClearBitmap(struct NonmovingSegment *seg) @@ -821,18 +824,21 @@ static void nonmovingPrepareMark(void) // Should have been cleared by the last sweep ASSERT(nonmovingHeap.sweep_list == NULL); + nonmovingHeap.n_caps = n_capabilities; nonmovingBumpEpoch(); for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { - struct NonmovingAllocator *alloca = nonmovingHeap.allocators[alloca_idx]; + struct NonmovingAllocator *alloca = &nonmovingHeap.allocators[alloca_idx]; // Update current segments' snapshot pointers - for (uint32_t cap_n = 0; cap_n < getNumCapabilities(); ++cap_n) { - struct NonmovingSegment *seg = alloca->current[cap_n]; + for (uint32_t cap_n = 0; cap_n < nonmovingHeap.n_caps; ++cap_n) { + Capability *cap = capabilities[cap_n]; + struct NonmovingSegment *seg = cap->current_segments[alloca_idx]; nonmovingSegmentInfo(seg)->next_free_snap = seg->next_free; } // Save the filled segments for later processing during the concurrent // mark phase. + ASSERT(alloca->saved_filled == NULL); alloca->saved_filled = alloca->filled; alloca->filled = NULL; @@ -886,43 +892,6 @@ static void nonmovingPrepareMark(void) #endif } -// Mark weak pointers in the non-moving heap. They'll either end up in -// dead_weak_ptr_list or stay in weak_ptr_list. Either way they need to be kept -// during sweep. See `MarkWeak.c:markWeakPtrList` for the moving heap variant -// of this. -static void nonmovingMarkWeakPtrList(MarkQueue *mark_queue, StgWeak *dead_weak_ptr_list) -{ - for (StgWeak *w = oldest_gen->weak_ptr_list; w; w = w->link) { - markQueuePushClosureGC(mark_queue, (StgClosure*)w); - // Do not mark finalizers and values here, those fields will be marked - // in `nonmovingMarkDeadWeaks` (for dead weaks) or - // `nonmovingTidyWeaks` (for live weaks) - } - - // We need to mark dead_weak_ptr_list too. This is subtle: - // - // - By the beginning of this GC we evacuated all weaks to the non-moving - // heap (in `markWeakPtrList`) - // - // - During the scavenging of the moving heap we discovered that some of - // those weaks are dead and moved them to `dead_weak_ptr_list`. Note that - // because of the fact above _all weaks_ are in the non-moving heap at - // this point. - // - // - So, to be able to traverse `dead_weak_ptr_list` and run finalizers we - // need to mark it. - for (StgWeak *w = dead_weak_ptr_list; w; w = w->link) { - markQueuePushClosureGC(mark_queue, (StgClosure*)w); - - // Mark the value and finalizer since they will be needed regardless of - // whether we find the weak is live. - if (w->cfinalizers != &stg_NO_FINALIZER_closure) { - markQueuePushClosureGC(mark_queue, w->value); - } - markQueuePushClosureGC(mark_queue, w->finalizer); - } -} - void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) { #if defined(THREADED_RTS) @@ -945,6 +914,7 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) ASSERT(n_nonmoving_marked_compact_blocks == 0); MarkQueue *mark_queue = stgMallocBytes(sizeof(MarkQueue), "mark queue"); + mark_queue->blocks = NULL; initMarkQueue(mark_queue); current_mark_queue = mark_queue; @@ -956,9 +926,16 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) capabilities[n], true/*don't mark sparks*/); } markScheduler((evac_fn)markQueueAddRoot, mark_queue); - nonmovingMarkWeakPtrList(mark_queue, *dead_weaks); markStablePtrTable((evac_fn)markQueueAddRoot, mark_queue); + // The dead weak pointer list shouldn't contain any weaks in the + // nonmoving heap +#if defined(DEBUG) + for (StgWeak *w = *dead_weaks; w; w = w->link) { + ASSERT(Bdescr((StgPtr) w)->gen != oldest_gen); + } +#endif + // Mark threads resurrected during moving heap scavenging for (StgTSO *tso = *resurrected_threads; tso != END_TSO_QUEUE; tso = tso->global_link) { markQueuePushClosureGC(mark_queue, (StgClosure*)tso); @@ -984,8 +961,23 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) // alive). ASSERT(oldest_gen->old_weak_ptr_list == NULL); ASSERT(nonmoving_old_weak_ptr_list == NULL); - nonmoving_old_weak_ptr_list = oldest_gen->weak_ptr_list; - oldest_gen->weak_ptr_list = NULL; + { + // Move both oldest_gen->weak_ptr_list and nonmoving_weak_ptr_list to + // nonmoving_old_weak_ptr_list + StgWeak **weaks = &oldest_gen->weak_ptr_list; + uint32_t n = 0; + while (*weaks) { + weaks = &(*weaks)->link; + n++; + } + debugTrace(DEBUG_nonmoving_gc, "%d new nonmoving weaks", n); + *weaks = nonmoving_weak_ptr_list; + nonmoving_old_weak_ptr_list = oldest_gen->weak_ptr_list; + nonmoving_weak_ptr_list = NULL; + oldest_gen->weak_ptr_list = NULL; + // At this point all weaks in the nonmoving generation are on + // nonmoving_old_weak_ptr_list + } trace(TRACE_nonmoving_gc, "Finished nonmoving GC preparation"); // We are now safe to start concurrent marking @@ -1021,19 +1013,25 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) } /* Mark queue, threads, and weak pointers until no more weaks have been - * resuscitated + * resuscitated. If *budget is non-zero then we will mark no more than + * Returns true if we there is no more marking work to be done, false if + * we exceeded our marking budget. */ -static void nonmovingMarkThreadsWeaks(MarkQueue *mark_queue) +static bool nonmovingMarkThreadsWeaks(MarkBudget *budget, MarkQueue *mark_queue) { while (true) { // Propagate marks - nonmovingMark(mark_queue); + nonmovingMark(budget, mark_queue); + if (*budget == 0) { + return false; + } // Tidy threads and weaks nonmovingTidyThreads(); - if (! nonmovingTidyWeaks(mark_queue)) - return; + if (! nonmovingTidyWeaks(mark_queue)) { + return true; + } } } @@ -1047,7 +1045,6 @@ static void* nonmovingConcurrentMark(void *data) return NULL; } -// TODO: Not sure where to put this function. // Append w2 to the end of w1. static void appendWeakList( StgWeak **w1, StgWeak *w2 ) { @@ -1067,13 +1064,14 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * // Walk the list of filled segments that we collected during preparation, // updated their snapshot pointers and move them to the sweep list. for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { - struct NonmovingSegment *filled = nonmovingHeap.allocators[alloca_idx]->saved_filled; + struct NonmovingSegment *filled = nonmovingHeap.allocators[alloca_idx].saved_filled; uint32_t n_filled = 0; if (filled) { struct NonmovingSegment *seg = filled; while (true) { // Set snapshot nonmovingSegmentInfo(seg)->next_free_snap = seg->next_free; + SET_SEGMENT_STATE(seg, FILLED_SWEEPING); n_filled++; if (seg->link) { seg = seg->link; @@ -1082,14 +1080,24 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * } } // add filled segments to sweep_list - SET_SEGMENT_STATE(seg, FILLED_SWEEPING); seg->link = nonmovingHeap.sweep_list; nonmovingHeap.sweep_list = filled; } + nonmovingHeap.allocators[alloca_idx].saved_filled = NULL; } + // Mark Weak#s + nonmovingMarkWeakPtrList(mark_queue); + // Do concurrent marking; most of the heap will get marked here. - nonmovingMarkThreadsWeaks(mark_queue); + +#if defined(THREADED_RTS) +concurrent_marking: +#endif + { + MarkBudget budget = UNLIMITED_MARK_BUDGET; + nonmovingMarkThreadsWeaks(&budget, mark_queue); + } #if defined(THREADED_RTS) Task *task = newBoundTask(); @@ -1098,21 +1106,13 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * if (sched_state > SCHED_RUNNING) { // Note that we break our invariants here and leave segments in // nonmovingHeap.sweep_list, don't free nonmoving_large_objects etc. - // However because we won't be running mark-sweep in the final GC this + // However because we won't be running sweep in the final GC this // is OK. - - // This is a RTS shutdown so we need to move our copy (snapshot) of - // weaks (nonmoving_old_weak_ptr_list and nonmoving_weak_ptr_list) to - // oldest_gen->threads to be able to run C finalizers in hs_exit_. Note - // that there may be more weaks added to oldest_gen->threads since we - // started mark, so we need to append our list to the tail of - // oldest_gen->threads. - appendWeakList(&nonmoving_old_weak_ptr_list, nonmoving_weak_ptr_list); - appendWeakList(&oldest_gen->weak_ptr_list, nonmoving_old_weak_ptr_list); - // These lists won't be used again so this is not necessary, but still - nonmoving_old_weak_ptr_list = NULL; - nonmoving_weak_ptr_list = NULL; - + // + // However, we must move any weak pointers remaining on + // nonmoving_old_weak_ptr_list back to nonmoving_weak_ptr_list + // such that their C finalizers can be run by hs_exit_. + appendWeakList(&nonmoving_weak_ptr_list, nonmoving_old_weak_ptr_list); goto finish; } @@ -1120,9 +1120,17 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * nonmovingBeginFlush(task); bool all_caps_syncd; + MarkBudget sync_marking_budget = sync_phase_marking_budget; do { all_caps_syncd = nonmovingWaitForFlush(); - nonmovingMarkThreadsWeaks(mark_queue); + if (nonmovingMarkThreadsWeaks(&sync_marking_budget, mark_queue) == false) { + // We ran out of budget for marking. Abort sync. + // See Note [Sync phase marking budget]. + traceConcSyncEnd(); + stat_endNonmovingGcSync(); + releaseAllCapabilities(n_capabilities, NULL, task); + goto concurrent_marking; + } } while (!all_caps_syncd); #endif @@ -1133,7 +1141,7 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * // Do last marking of weak pointers while (true) { // Propagate marks - nonmovingMark(mark_queue); + nonmovingMarkUnlimitedBudget(mark_queue); if (!nonmovingTidyWeaks(mark_queue)) break; @@ -1142,7 +1150,7 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * nonmovingMarkDeadWeaks(mark_queue, dead_weaks); // Propagate marks - nonmovingMark(mark_queue); + nonmovingMarkUnlimitedBudget(mark_queue); // Now remove all dead objects from the mut_list to ensure that a younger // generation collection doesn't attempt to look at them after we've swept. @@ -1184,15 +1192,9 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * nonmoving_old_threads = END_TSO_QUEUE; } - { - StgWeak **weaks = &oldest_gen->weak_ptr_list; - while (*weaks) { - weaks = &(*weaks)->link; - } - *weaks = nonmoving_weak_ptr_list; - nonmoving_weak_ptr_list = NULL; - nonmoving_old_weak_ptr_list = NULL; - } + // At this point point any weak that remains on nonmoving_old_weak_ptr_list + // has a dead key. + nonmoving_old_weak_ptr_list = NULL; // Prune spark lists // See Note [Spark management under the nonmoving collector]. @@ -1290,10 +1292,12 @@ void assert_in_nonmoving_heap(StgPtr p) } for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { - struct NonmovingAllocator *alloca = nonmovingHeap.allocators[alloca_idx]; + struct NonmovingAllocator *alloca = &nonmovingHeap.allocators[alloca_idx]; + // Search current segments - for (uint32_t cap_idx = 0; cap_idx < getNumCapabilities(); ++cap_idx) { - struct NonmovingSegment *seg = alloca->current[cap_idx]; + for (uint32_t cap_idx = 0; cap_idx < nonmovingHeap.n_caps; ++cap_idx) { + Capability *cap = capabilities[cap_idx]; + struct NonmovingSegment *seg = cap->current_segments[alloca_idx]; if (p >= (P_)seg && p < (((P_)seg) + NONMOVING_SEGMENT_SIZE_W)) { return; } @@ -1352,33 +1356,16 @@ void nonmovingPrintSegment(struct NonmovingSegment *seg) debugBelch("End of segment\n\n"); } -void nonmovingPrintAllocator(struct NonmovingAllocator *alloc) -{ - debugBelch("Allocator at %p\n", (void*)alloc); - debugBelch("Filled segments:\n"); - for (struct NonmovingSegment *seg = alloc->filled; seg != NULL; seg = seg->link) { - debugBelch("%p ", (void*)seg); - } - debugBelch("\nActive segments:\n"); - for (struct NonmovingSegment *seg = alloc->active; seg != NULL; seg = seg->link) { - debugBelch("%p ", (void*)seg); - } - debugBelch("\nCurrent segments:\n"); - for (uint32_t i = 0; i < getNumCapabilities(); ++i) { - debugBelch("%p ", alloc->current[i]); - } - debugBelch("\n"); -} - void locate_object(P_ obj) { // Search allocators for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { - struct NonmovingAllocator *alloca = nonmovingHeap.allocators[alloca_idx]; - for (uint32_t cap = 0; cap < getNumCapabilities(); ++cap) { - struct NonmovingSegment *seg = alloca->current[cap]; + struct NonmovingAllocator *alloca = &nonmovingHeap.allocators[alloca_idx]; + for (uint32_t cap_n = 0; cap_n < nonmovingHeap.n_caps; ++cap_n) { + Capability *cap = capabilities[cap_n]; + struct NonmovingSegment *seg = cap->current_segments[alloca_idx]; if (obj >= (P_)seg && obj < (((P_)seg) + NONMOVING_SEGMENT_SIZE_W)) { - debugBelch("%p is in current segment of capability %d of allocator %d at %p\n", obj, cap, alloca_idx, (void*)seg); + debugBelch("%p is in current segment of capability %d of allocator %d at %p\n", obj, cap_n, alloca_idx, (void*)seg); return; } } ===================================== rts/sm/NonMoving.h ===================================== @@ -84,8 +84,7 @@ struct NonmovingAllocator { struct NonmovingSegment *filled; struct NonmovingSegment *saved_filled; struct NonmovingSegment *active; - // indexed by capability number - struct NonmovingSegment *current[]; + // N.B. Per-capabilty "current" segment lives in Capability }; // first allocator is of size 2^NONMOVING_ALLOCA0 (in bytes) @@ -99,7 +98,7 @@ struct NonmovingAllocator { #define NONMOVING_MAX_FREE 16 struct NonmovingHeap { - struct NonmovingAllocator *allocators[NONMOVING_ALLOCA_CNT]; + struct NonmovingAllocator allocators[NONMOVING_ALLOCA_CNT]; // free segment list. This is a cache where we keep up to // NONMOVING_MAX_FREE segments to avoid thrashing the block allocator. // Note that segments in this list are still counted towards @@ -149,7 +148,7 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads); void *nonmovingAllocate(Capability *cap, StgWord sz); -void nonmovingAddCapabilities(uint32_t new_n_caps); +void nonmovingInitCapability(Capability *cap); void nonmovingPushFreeSegment(struct NonmovingSegment *seg); void nonmovingClearBitmap(struct NonmovingSegment *seg); @@ -166,7 +165,7 @@ INLINE_HEADER uint8_t nonmovingSegmentLogBlockSize(struct NonmovingSegment *seg) INLINE_HEADER void nonmovingPushActiveSegment(struct NonmovingSegment *seg) { struct NonmovingAllocator *alloc = - nonmovingHeap.allocators[nonmovingSegmentLogBlockSize(seg) - NONMOVING_ALLOCA0]; + &nonmovingHeap.allocators[nonmovingSegmentLogBlockSize(seg) - NONMOVING_ALLOCA0]; SET_SEGMENT_STATE(seg, ACTIVE); while (true) { struct NonmovingSegment *current_active = (struct NonmovingSegment*)VOLATILE_LOAD(&alloc->active); @@ -181,7 +180,7 @@ INLINE_HEADER void nonmovingPushActiveSegment(struct NonmovingSegment *seg) INLINE_HEADER void nonmovingPushFilledSegment(struct NonmovingSegment *seg) { struct NonmovingAllocator *alloc = - nonmovingHeap.allocators[nonmovingSegmentLogBlockSize(seg) - NONMOVING_ALLOCA0]; + &nonmovingHeap.allocators[nonmovingSegmentLogBlockSize(seg) - NONMOVING_ALLOCA0]; SET_SEGMENT_STATE(seg, FILLED); while (true) { struct NonmovingSegment *current_filled = (struct NonmovingSegment*)VOLATILE_LOAD(&alloc->filled); @@ -289,20 +288,17 @@ INLINE_HEADER void nonmovingSetClosureMark(StgPtr p) nonmovingSetMark(nonmovingGetSegment(p), nonmovingGetBlockIdx(p)); } -// TODO: Audit the uses of these -/* Was the given closure marked this major GC cycle? */ -INLINE_HEADER bool nonmovingClosureMarkedThisCycle(StgPtr p) +INLINE_HEADER uint8_t nonmovingGetClosureMark(StgPtr p) { struct NonmovingSegment *seg = nonmovingGetSegment(p); nonmoving_block_idx blk_idx = nonmovingGetBlockIdx(p); - return nonmovingGetMark(seg, blk_idx) == nonmovingMarkEpoch; + return nonmovingGetMark(seg, blk_idx); } -INLINE_HEADER bool nonmovingClosureMarked(StgPtr p) +/* Was the given closure marked this major GC cycle? */ +INLINE_HEADER bool nonmovingClosureMarkedThisCycle(StgPtr p) { - struct NonmovingSegment *seg = nonmovingGetSegment(p); - nonmoving_block_idx blk_idx = nonmovingGetBlockIdx(p); - return nonmovingGetMark(seg, blk_idx) != 0; + return nonmovingGetClosureMark(p) == nonmovingMarkEpoch; } // Can be called during a major collection to determine whether a particular @@ -336,10 +332,14 @@ INLINE_HEADER bool nonmovingClosureBeingSwept(StgClosure *p) } } +// N.B. RtsFlags is defined as a pointer in STG code consequently this code +// doesn't typecheck. +#if !IN_STG_CODE INLINE_HEADER bool isNonmovingClosure(StgClosure *p) { - return !HEAP_ALLOCED_GC(p) || Bdescr((P_)p)->flags & BF_NONMOVING; + return RtsFlags.GcFlags.useNonmoving && (!HEAP_ALLOCED_GC(p) || Bdescr((P_)p)->flags & BF_NONMOVING); } +#endif #if defined(DEBUG) ===================================== rts/sm/NonMovingCensus.c ===================================== @@ -21,10 +21,12 @@ // stopped. In this case is safe to look at active and current segments so we can // also collect statistics on live words. static struct NonmovingAllocCensus -nonmovingAllocatorCensus_(struct NonmovingAllocator *alloc, bool collect_live_words) +nonmovingAllocatorCensus_(uint32_t alloc_idx, bool collect_live_words) { struct NonmovingAllocCensus census = {collect_live_words, 0, 0, 0, 0}; + struct NonmovingAllocator *alloc = &nonmovingHeap.allocators[alloc_idx]; + // filled segments for (struct NonmovingSegment *seg = alloc->filled; seg != NULL; seg = seg->link) @@ -40,6 +42,7 @@ nonmovingAllocatorCensus_(struct NonmovingAllocator *alloc, bool collect_live_wo } } + // active segments for (struct NonmovingSegment *seg = alloc->active; seg != NULL; seg = seg->link) @@ -56,9 +59,11 @@ nonmovingAllocatorCensus_(struct NonmovingAllocator *alloc, bool collect_live_wo } } - for (unsigned int cap=0; cap < getNumCapabilities(); cap++) + // current segments + for (unsigned int cap_n=0; cap_n < getNumCapabilities(); cap_n++) { - struct NonmovingSegment *seg = alloc->current[cap]; + Capability *cap = capabilities[cap_n]; + struct NonmovingSegment *seg = cap->current_segments[alloc_idx]; unsigned int n = nonmovingSegmentBlockCount(seg); for (unsigned int i=0; i < n; i++) { if (nonmovingGetMark(seg, i)) { @@ -76,15 +81,15 @@ nonmovingAllocatorCensus_(struct NonmovingAllocator *alloc, bool collect_live_wo * all blocks in nonmoving heap are valid closures. */ struct NonmovingAllocCensus -nonmovingAllocatorCensusWithWords(struct NonmovingAllocator *alloc) +nonmovingAllocatorCensusWithWords(uint32_t alloc_idx) { - return nonmovingAllocatorCensus_(alloc, true); + return nonmovingAllocatorCensus_(alloc_idx, true); } struct NonmovingAllocCensus -nonmovingAllocatorCensus(struct NonmovingAllocator *alloc) +nonmovingAllocatorCensus(uint32_t alloc_idx) { - return nonmovingAllocatorCensus_(alloc, false); + return nonmovingAllocatorCensus_(alloc_idx, false); } @@ -130,7 +135,7 @@ void nonmovingPrintAllocatorCensus(bool collect_live_words) for (int i=0; i < NONMOVING_ALLOCA_CNT; i++) { struct NonmovingAllocCensus census = - nonmovingAllocatorCensus_(nonmovingHeap.allocators[i], collect_live_words); + nonmovingAllocatorCensus_(i, collect_live_words); print_alloc_census(i, census); } @@ -143,8 +148,7 @@ void nonmovingTraceAllocatorCensus() return; for (int i=0; i < NONMOVING_ALLOCA_CNT; i++) { - const struct NonmovingAllocCensus census = - nonmovingAllocatorCensus(nonmovingHeap.allocators[i]); + const struct NonmovingAllocCensus census = nonmovingAllocatorCensus(i); const uint32_t log_blk_size = i + NONMOVING_ALLOCA0; traceNonmovingHeapCensus(log_blk_size, &census); } ===================================== rts/sm/NonMovingCensus.h ===================================== @@ -20,10 +20,10 @@ struct NonmovingAllocCensus { struct NonmovingAllocCensus -nonmovingAllocatorCensusWithWords(struct NonmovingAllocator *alloc); +nonmovingAllocatorCensusWithWords(uint32_t alloc_idx); struct NonmovingAllocCensus -nonmovingAllocatorCensus(struct NonmovingAllocator *alloc); +nonmovingAllocatorCensus(uint32_t alloc_idx); void nonmovingPrintAllocatorCensus(bool collect_live_words); void nonmovingTraceAllocatorCensus(void); ===================================== rts/sm/NonMovingMark.c ===================================== @@ -37,6 +37,7 @@ static void trace_PAP_payload (MarkQueue *queue, StgClosure *fun, StgClosure **payload, StgWord size); +static bool is_nonmoving_weak(StgWeak *weak); // How many Array# entries to add to the mark queue at once? #define MARK_ARRAY_CHUNK_LENGTH 128 @@ -252,7 +253,7 @@ StgWord nonmoving_write_barrier_enabled = false; MarkQueue *current_mark_queue = NULL; /* Initialise update remembered set data structures */ -void nonmovingMarkInitUpdRemSet() { +void nonmovingMarkInit() { #if defined(THREADED_RTS) initMutex(&upd_rem_set_lock); initCondition(&upd_rem_set_flushed_cond); @@ -272,6 +273,7 @@ static void nonmovingAddUpdRemSetBlocks_(MarkQueue *rset) bdescr *end = start; while (end->link != NULL) end = end->link; + rset->blocks = NULL; // add the blocks to the global remembered set ACQUIRE_LOCK(&upd_rem_set_lock); @@ -295,8 +297,8 @@ static void nonmovingAddUpdRemSetBlocks_lock(MarkQueue *rset) // Reset the state of the remembered set. ACQUIRE_SM_LOCK; init_mark_queue_(rset); - rset->is_upd_rem_set = true; RELEASE_SM_LOCK; + rset->is_upd_rem_set = true; } /* @@ -649,6 +651,16 @@ void updateRemembSetPushThunkEager(Capability *cap, } break; } + case THUNK_SELECTOR: + { + StgSelector *sel = (StgSelector *) thunk; + if (check_in_nonmoving_heap(sel->selectee)) { + // Don't bother to push origin; it makes the barrier needlessly + // expensive with little benefit. + push_closure(queue, sel->selectee, NULL); + } + break; + } case AP: { StgAP *ap = (StgAP *) thunk; @@ -658,9 +670,11 @@ void updateRemembSetPushThunkEager(Capability *cap, trace_PAP_payload(queue, ap->fun, ap->payload, ap->n_args); break; } - case THUNK_SELECTOR: + // We may end up here if a thunk update races with another update. + // In this case there is nothing to do as the other thread will have + // already pushed the updated thunk's free variables to the update + // remembered set. case BLACKHOLE: - // TODO: This is right, right? break; // The selector optimization performed by the nonmoving mark may have // overwritten a thunk which we are updating with an indirection. @@ -907,6 +921,7 @@ static MarkQueueEnt markQueuePop (MarkQueue *q) static void init_mark_queue_ (MarkQueue *queue) { bdescr *bd = allocGroup(MARK_QUEUE_BLOCKS); + ASSERT(queue->blocks == NULL); queue->blocks = bd; queue->top = (MarkQueueBlock *) bd->start; queue->top->head = 0; @@ -1289,8 +1304,11 @@ mark_closure (MarkQueue *queue, const StgClosure *p0, StgClosure **origin) goto done; case WHITEHOLE: - while (*(StgInfoTable* volatile*) &p->header.info == &stg_WHITEHOLE_info); - // busy_wait_nop(); // FIXME + while (*(StgInfoTable* volatile*) &p->header.info == &stg_WHITEHOLE_info) +#if defined(PARALLEL_GC) + busy_wait_nop() +#endif + ; goto try_again; default: @@ -1498,10 +1516,12 @@ mark_closure (MarkQueue *queue, const StgClosure *p0, StgClosure **origin) break; } + case WEAK: + ASSERT(is_nonmoving_weak((StgWeak*) p)); + // fallthrough gen_obj: case CONSTR: case CONSTR_NOCAF: - case WEAK: case PRIM: { for (StgWord i = 0; i < info->layout.payload.ptrs; i++) { @@ -1554,8 +1574,15 @@ mark_closure (MarkQueue *queue, const StgClosure *p0, StgClosure **origin) } case THUNK_SELECTOR: - nonmoving_eval_thunk_selector(queue, (StgSelector*)p, origin); + { + StgSelector *sel = (StgSelector *) p; + // We may be able to evaluate this selector which may render the + // selectee unreachable. However, we must mark the selectee regardless + // to satisfy the snapshot invariant. + PUSH_FIELD(sel, selectee); + nonmoving_eval_thunk_selector(queue, sel, origin); break; + } case AP_STACK: { StgAP_STACK *ap = (StgAP_STACK *)p; @@ -1705,15 +1732,23 @@ done: * b. the nursery has been fully evacuated into the non-moving generation. * c. the mark queue has been seeded with a set of roots. * + * If budget is not UNLIMITED_MARK_BUDGET, then we will mark no more than the + * indicated number of objects and deduct the work done from the budget. */ GNUC_ATTR_HOT void -nonmovingMark (MarkQueue *queue) +nonmovingMark (MarkBudget* budget, MarkQueue *queue) { traceConcMarkBegin(); debugTrace(DEBUG_nonmoving_gc, "Starting mark pass"); - unsigned int count = 0; + uint64_t count = 0; while (true) { count++; + if (*budget == 0) { + return; + } else if (*budget != UNLIMITED_MARK_BUDGET) { + *budget -= 1; + } + MarkQueueEnt ent = markQueuePop(queue); switch (nonmovingMarkQueueEntryType(&ent)) { @@ -1842,20 +1877,64 @@ static bool nonmovingIsNowAlive (StgClosure *p) bdescr *bd = Bdescr((P_)p); - // All non-static objects in the non-moving heap should be marked as - // BF_NONMOVING - ASSERT(bd->flags & BF_NONMOVING); + const uint16_t flags = bd->flags; + if (flags & BF_LARGE) { + if (flags & BF_PINNED && !(flags & BF_NONMOVING)) { + // In this case we have a pinned object living in a non-full + // accumulator block which was not promoted to the nonmoving + // generation. Assume that the object is alive. + // See #22014. + return true; + } - if (bd->flags & BF_LARGE) { + ASSERT(bd->flags & BF_NONMOVING); return (bd->flags & BF_NONMOVING_SWEEPING) == 0 // the large object wasn't in the snapshot and therefore wasn't marked || (bd->flags & BF_MARKED) != 0; // The object was marked } else { - return nonmovingClosureMarkedThisCycle((P_)p); + // All non-static objects in the non-moving heap should be marked as + // BF_NONMOVING. + ASSERT(bd->flags & BF_NONMOVING); + + struct NonmovingSegment *seg = nonmovingGetSegment((StgPtr) p); + StgClosure *snapshot_loc = + (StgClosure *) nonmovingSegmentGetBlock(seg, nonmovingSegmentInfo(seg)->next_free_snap); + if (p >= snapshot_loc && nonmovingGetClosureMark((StgPtr) p) == 0) { + /* + * In this case we are looking at a block that wasn't allocated + * at the time that the snapshot was taken. As we do not mark such + * blocks, we must assume that it is reachable. + */ + return true; + } else { + return nonmovingClosureMarkedThisCycle((P_)p); + } } } +// Mark all Weak#s on nonmoving_old_weak_ptr_list. +void nonmovingMarkWeakPtrList (struct MarkQueue_ *queue) +{ + ASSERT(nonmoving_weak_ptr_list == NULL); + for (StgWeak *w = nonmoving_old_weak_ptr_list; w != NULL; w = w->link) { + mark_closure(queue, (StgClosure *) w, NULL); + } +} + +// Determine whether a weak pointer object is on one of the nonmoving +// collector's weak pointer lists. Used for sanity checking. +static bool is_nonmoving_weak(StgWeak *weak) +{ + for (StgWeak *w = nonmoving_old_weak_ptr_list; w != NULL; w = w->link) { + if (w == weak) return true; + } + for (StgWeak *w = nonmoving_weak_ptr_list; w != NULL; w = w->link) { + if (w == weak) return true; + } + return false; +} + // Non-moving heap variant of `tidyWeakList` bool nonmovingTidyWeaks (struct MarkQueue_ *queue) { @@ -1864,6 +1943,9 @@ bool nonmovingTidyWeaks (struct MarkQueue_ *queue) StgWeak **last_w = &nonmoving_old_weak_ptr_list; StgWeak *next_w; for (StgWeak *w = nonmoving_old_weak_ptr_list; w != NULL; w = next_w) { + // This should have been marked by nonmovingMarkWeaks + ASSERT(nonmovingIsNowAlive((StgClosure *) w)); + if (w->header.info == &stg_DEAD_WEAK_info) { // finalizeWeak# was called on the weak next_w = w->link; @@ -1874,7 +1956,10 @@ bool nonmovingTidyWeaks (struct MarkQueue_ *queue) // Otherwise it's a live weak ASSERT(w->header.info == &stg_WEAK_info); - if (nonmovingIsNowAlive(w->key)) { + // See Note [Weak pointer processing and the non-moving GC] in + // MarkWeak.c + bool key_in_nonmoving = Bdescr((StgPtr) w->key)->flags & BF_NONMOVING; + if (!key_in_nonmoving || nonmovingIsNowAlive(w->key)) { nonmovingMarkLiveWeak(queue, w); did_work = true; @@ -1882,7 +1967,7 @@ bool nonmovingTidyWeaks (struct MarkQueue_ *queue) *last_w = w->link; next_w = w->link; - // and put it on the weak ptr list + // and put it on nonmoving_weak_ptr_list w->link = nonmoving_weak_ptr_list; nonmoving_weak_ptr_list = w; } else { @@ -1904,7 +1989,8 @@ void nonmovingMarkDeadWeak (struct MarkQueue_ *queue, StgWeak *w) void nonmovingMarkLiveWeak (struct MarkQueue_ *queue, StgWeak *w) { - ASSERT(nonmovingClosureMarkedThisCycle((P_)w)); + ASSERT(nonmovingIsNowAlive((StgClosure *) w)); + ASSERT(nonmovingIsNowAlive((StgClosure *) w->key)); markQueuePushClosure_(queue, w->value); markQueuePushClosure_(queue, w->finalizer); markQueuePushClosure_(queue, w->cfinalizers); @@ -1918,9 +2004,9 @@ void nonmovingMarkDeadWeaks (struct MarkQueue_ *queue, StgWeak **dead_weaks) { StgWeak *next_w; for (StgWeak *w = nonmoving_old_weak_ptr_list; w; w = next_w) { - ASSERT(!nonmovingClosureMarkedThisCycle((P_)(w->key))); + ASSERT(!nonmovingIsNowAlive(w->key)); nonmovingMarkDeadWeak(queue, w); - next_w = w ->link; + next_w = w->link; w->link = *dead_weaks; *dead_weaks = w; } ===================================== rts/sm/NonMovingMark.h ===================================== @@ -111,6 +111,11 @@ typedef struct { MarkQueue queue; } UpdRemSet; +// How much marking work we are allowed to perform +// See Note [Sync phase marking budget] in NonMoving.c +typedef int64_t MarkBudget; +#define UNLIMITED_MARK_BUDGET INT64_MIN + // Number of blocks to allocate for a mark queue #define MARK_QUEUE_BLOCKS 16 @@ -135,7 +140,7 @@ extern MarkQueue *current_mark_queue; extern bdescr *upd_rem_set_block_list; -void nonmovingMarkInitUpdRemSet(void); +void nonmovingMarkInit(void); void nonmovingInitUpdRemSet(UpdRemSet *rset); void updateRemembSetPushClosure(Capability *cap, StgClosure *p); @@ -154,8 +159,13 @@ void markQueueAddRoot(MarkQueue* q, StgClosure** root); void initMarkQueue(MarkQueue *queue); void freeMarkQueue(MarkQueue *queue); -void nonmovingMark(struct MarkQueue_ *restrict queue); +void nonmovingMark(MarkBudget *budget, struct MarkQueue_ *restrict queue); +INLINE_HEADER void nonmovingMarkUnlimitedBudget(struct MarkQueue_ *restrict queue) { + MarkBudget budget = UNLIMITED_MARK_BUDGET; + nonmovingMark(&budget, queue); +} +void nonmovingMarkWeakPtrList(struct MarkQueue_ *queue); bool nonmovingTidyWeaks(struct MarkQueue_ *queue); void nonmovingTidyThreads(void); void nonmovingMarkDeadWeaks(struct MarkQueue_ *queue, StgWeak **dead_weak_ptr_list); ===================================== rts/sm/Sanity.c ===================================== @@ -619,11 +619,12 @@ static void checkNonmovingSegments (struct NonmovingSegment *seg) void checkNonmovingHeap (const struct NonmovingHeap *heap) { for (unsigned int i=0; i < NONMOVING_ALLOCA_CNT; i++) { - const struct NonmovingAllocator *alloc = heap->allocators[i]; + const struct NonmovingAllocator *alloc = &heap->allocators[i]; checkNonmovingSegments(alloc->filled); checkNonmovingSegments(alloc->active); - for (unsigned int cap=0; cap < getNumCapabilities(); cap++) { - checkNonmovingSegments(alloc->current[cap]); + for (unsigned int cap_n=0; cap_n < getNumCapabilities(); cap_n++) { + Capability *cap = capabilities[cap_n]; + checkNonmovingSegments(cap->current_segments[i]); } } } @@ -1047,11 +1048,12 @@ findMemoryLeak (void) markBlocks(nonmoving_compact_objects); markBlocks(nonmoving_marked_compact_objects); for (i = 0; i < NONMOVING_ALLOCA_CNT; i++) { - struct NonmovingAllocator *alloc = nonmovingHeap.allocators[i]; + struct NonmovingAllocator *alloc = &nonmovingHeap.allocators[i]; markNonMovingSegments(alloc->filled); markNonMovingSegments(alloc->active); for (j = 0; j < getNumCapabilities(); j++) { - markNonMovingSegments(alloc->current[j]); + Capability *cap = capabilities[j]; + markNonMovingSegments(cap->current_segments[i]); } } markNonMovingSegments(nonmovingHeap.sweep_list); @@ -1156,23 +1158,18 @@ countNonMovingSegments(struct NonmovingSegment *segs) return ret; } -static W_ -countNonMovingAllocator(struct NonmovingAllocator *alloc) -{ - W_ ret = countNonMovingSegments(alloc->filled) - + countNonMovingSegments(alloc->active); - for (uint32_t i = 0; i < getNumCapabilities(); ++i) { - ret += countNonMovingSegments(alloc->current[i]); - } - return ret; -} - static W_ countNonMovingHeap(struct NonmovingHeap *heap) { W_ ret = 0; for (int alloc_idx = 0; alloc_idx < NONMOVING_ALLOCA_CNT; alloc_idx++) { - ret += countNonMovingAllocator(heap->allocators[alloc_idx]); + struct NonmovingAllocator *alloc = &heap->allocators[alloc_idx]; + ret += countNonMovingSegments(alloc->filled); + ret += countNonMovingSegments(alloc->active); + for (uint32_t c = 0; c < getNumCapabilities(); ++c) { + Capability *cap = capabilities[c]; + ret += countNonMovingSegments(cap->current_segments[alloc_idx]); + } } ret += countNonMovingSegments(heap->sweep_list); ret += countNonMovingSegments(heap->free); ===================================== rts/sm/Storage.c ===================================== @@ -214,17 +214,14 @@ initStorage (void) } oldest_gen->to = oldest_gen; - // Nonmoving heap uses oldest_gen so initialize it after initializing oldest_gen - nonmovingInit(); - #if defined(THREADED_RTS) // nonmovingAddCapabilities allocates segments, which requires taking the gc // sync lock, so initialize it before nonmovingAddCapabilities initSpinLock(&gc_alloc_block_sync); #endif - if (RtsFlags.GcFlags.useNonmoving) - nonmovingAddCapabilities(getNumCapabilities()); + // Nonmoving heap uses oldest_gen so initialize it after initializing oldest_gen + nonmovingInit(); /* The oldest generation has one step. */ if (RtsFlags.GcFlags.compact || RtsFlags.GcFlags.sweep) { @@ -320,11 +317,10 @@ void storageAddCapabilities (uint32_t from, uint32_t to) } } - // Initialize NonmovingAllocators and UpdRemSets + // Initialize non-moving collector if (RtsFlags.GcFlags.useNonmoving) { - nonmovingAddCapabilities(to); - for (i = 0; i < to; ++i) { - nonmovingInitUpdRemSet(&capabilities[i]->upd_rem_set); + for (i = from; i < to; i++) { + nonmovingInitCapability(capabilities[i]); } } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fdebde7650dd61debcd941f894f397e7e30e3644...cfb775f0235d34d3831d8e1cafb51293d7664cc2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fdebde7650dd61debcd941f894f397e7e30e3644...cfb775f0235d34d3831d8e1cafb51293d7664cc2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 20:03:04 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Tue, 07 Feb 2023 15:03:04 -0500 Subject: [Git][ghc/ghc][wip/az/T22919-module-where] EPA: Comment between module and where should be in header comments Message-ID: <63e2ae78acb99_1108fe6969b2e8181588c@gitlab.mail> Alan Zimmerman pushed to branch wip/az/T22919-module-where at Glasgow Haskell Compiler / GHC Commits: f6f2a65a by Alan Zimmerman at 2023-02-07T20:01:57+00:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - 8 changed files: - compiler/GHC/Parser/Lexer.x - + testsuite/tests/ghc-api/exactprint/T22919.hs - + testsuite/tests/ghc-api/exactprint/T22919.stderr - testsuite/tests/ghc-api/exactprint/Test20239.stderr - testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr - testsuite/tests/ghc-api/exactprint/all.T - testsuite/tests/parser/should_compile/DumpParsedAstComments.hs - testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr Changes: ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -3701,11 +3701,13 @@ allocatePriorComments ss comment_q mheader_comments = cmp (L l _) = anchor l <= ss (newAnns,after) = partition cmp comment_q comment_q'= after - (prior_comments, decl_comments) = splitPriorComments ss newAnns + (prior_comments, decl_comments) + = case mheader_comments of + Strict.Nothing -> (reverse newAnns, []) + _ -> splitPriorComments ss newAnns in case mheader_comments of Strict.Nothing -> (Strict.Just prior_comments, comment_q', decl_comments) - -- Strict.Nothing -> (Strict.Just [], comment_q', newAnns) Strict.Just _ -> (mheader_comments, comment_q', reverse newAnns) allocateFinalComments ===================================== testsuite/tests/ghc-api/exactprint/T22919.hs ===================================== @@ -0,0 +1,2 @@ +module T22919 {- comment -} where +foo = 's' ===================================== testsuite/tests/ghc-api/exactprint/T22919.stderr ===================================== @@ -0,0 +1,116 @@ + +==================== Parser AST ==================== + +(L + { T22919.hs:1:1 } + (HsModule + (XModulePs + (EpAnn + (Anchor + { T22919.hs:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnModule (EpaSpan { T22919.hs:1:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { T22919.hs:1:29-33 }))] + (AnnList + (Nothing) + (Nothing) + (Nothing) + [] + []) + (Just + ((,) + { T22919.hs:3:1 } + { T22919.hs:2:7-9 }))) + (EpaCommentsBalanced + [(L + (Anchor + { T22919.hs:1:15-27 } + (UnchangedAnchor)) + (EpaComment + (EpaBlockComment + "{- comment -}") + { T22919.hs:1:8-13 }))] + [])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) + (Just + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:1:8-13 }) + {ModuleName: T22919})) + (Nothing) + [] + [(L + (SrcSpanAnn (EpAnn + (Anchor + { T22919.hs:2:1-9 } + (UnchangedAnchor)) + (AnnListItem + []) + (EpaComments + [])) { T22919.hs:2:1-9 }) + (ValD + (NoExtField) + (FunBind + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-3 }) + (Unqual + {OccName: foo})) + (MG + (FromSource) + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-9 }) + [(L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-9 }) + (Match + (EpAnn + (Anchor + { T22919.hs:2:1-9 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (FunRhs + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-3 }) + (Unqual + {OccName: foo})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (EpaComments + []) + [(L + (SrcSpanAnn + (EpAnnNotUsed) + { T22919.hs:2:5-9 }) + (GRHS + (EpAnn + (Anchor + { T22919.hs:2:5-9 } + (UnchangedAnchor)) + (GrhsAnn + (Nothing) + (AddEpAnn AnnEqual (EpaSpan { T22919.hs:2:5 }))) + (EpaComments + [])) + [] + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:7-9 }) + (HsLit + (EpAnn + (Anchor + { T22919.hs:2:7-9 } + (UnchangedAnchor)) + (NoEpAnns) + (EpaComments + [])) + (HsChar + (SourceText 's') + ('s'))))))] + (EmptyLocalBinds + (NoExtField)))))])))))])) ===================================== testsuite/tests/ghc-api/exactprint/Test20239.stderr ===================================== @@ -23,7 +23,14 @@ { Test20239.hs:8:1 } { Test20239.hs:7:34-63 }))) (EpaCommentsBalanced - [] + [(L + (Anchor + { Test20239.hs:3:1-28 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- | Leading Haddock Comment") + { Test20239.hs:1:18-22 }))] [(L (Anchor { Test20239.hs:7:34-63 } @@ -50,14 +57,7 @@ (AnnListItem []) (EpaComments - [(L - (Anchor - { Test20239.hs:3:1-28 } - (UnchangedAnchor)) - (EpaComment - (EpaLineComment - "-- | Leading Haddock Comment") - { Test20239.hs:1:18-22 }))])) { Test20239.hs:(4,1)-(6,86) }) + [])) { Test20239.hs:(4,1)-(6,86) }) (InstD (NoExtField) (DataFamInstD @@ -323,5 +323,5 @@ -Test20239.hs:4:15: error: [GHC-76037] +Test20239.hs:4:15: [GHC-76037] Not in scope: type constructor or class ‘Method’ ===================================== testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr ===================================== @@ -30,7 +30,15 @@ (EpaComment (EpaLineComment "-- leading comments") - { ZeroWidthSemi.hs:1:22-26 }))] + { ZeroWidthSemi.hs:1:22-26 })) + ,(L + (Anchor + { ZeroWidthSemi.hs:5:1-19 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- Function comment") + { ZeroWidthSemi.hs:3:1-19 }))] [(L (Anchor { ZeroWidthSemi.hs:8:1-58 } @@ -57,14 +65,7 @@ (AnnListItem []) (EpaComments - [(L - (Anchor - { ZeroWidthSemi.hs:5:1-19 } - (UnchangedAnchor)) - (EpaComment - (EpaLineComment - "-- Function comment") - { ZeroWidthSemi.hs:3:1-19 }))])) { ZeroWidthSemi.hs:6:1-5 }) + [])) { ZeroWidthSemi.hs:6:1-5 }) (ValD (NoExtField) (FunBind ===================================== testsuite/tests/ghc-api/exactprint/all.T ===================================== @@ -38,3 +38,4 @@ test('AddHiding1', ignore_stderr, makefile_test, ['AddHiding1']) test('AddHiding2', ignore_stderr, makefile_test, ['AddHiding2']) test('Test20239', normal, compile_fail, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments']) test('ZeroWidthSemi', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments']) +test('T22919', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments']) ===================================== testsuite/tests/parser/should_compile/DumpParsedAstComments.hs ===================================== @@ -4,6 +4,9 @@ -} module DumpParsedAstComments where +-- comment 1 for bar +-- comment 2 for bar +bar = 1 -- Other comment -- comment 1 for foo ===================================== testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr ===================================== @@ -21,8 +21,8 @@ []) (Just ((,) - { DumpParsedAstComments.hs:17:1 } - { DumpParsedAstComments.hs:16:17-23 }))) + { DumpParsedAstComments.hs:20:1 } + { DumpParsedAstComments.hs:19:17-23 }))) (EpaCommentsBalanced [(L (Anchor @@ -42,12 +42,20 @@ { DumpParsedAstComments.hs:1:1-28 })) ,(L (Anchor - { DumpParsedAstComments.hs:7:1-16 } + { DumpParsedAstComments.hs:7:1-20 } (UnchangedAnchor)) (EpaComment (EpaLineComment - "-- Other comment") - { DumpParsedAstComments.hs:5:30-34 }))] + "-- comment 1 for bar") + { DumpParsedAstComments.hs:5:30-34 })) + ,(L + (Anchor + { DumpParsedAstComments.hs:8:1-20 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- comment 2 for bar") + { DumpParsedAstComments.hs:7:1-20 }))] [])) (VirtualBraces (1)) @@ -62,55 +70,139 @@ [(L (SrcSpanAnn (EpAnn (Anchor - { DumpParsedAstComments.hs:(11,1)-(13,3) } + { DumpParsedAstComments.hs:9:1-7 } + (UnchangedAnchor)) + (AnnListItem + []) + (EpaComments + [])) { DumpParsedAstComments.hs:9:1-7 }) + (ValD + (NoExtField) + (FunBind + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-3 }) + (Unqual + {OccName: bar})) + (MG + (FromSource) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-7 }) + [(L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-7 }) + (Match + (EpAnn + (Anchor + { DumpParsedAstComments.hs:9:1-7 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (FunRhs + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-3 }) + (Unqual + {OccName: bar})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (EpaComments + []) + [(L + (SrcSpanAnn + (EpAnnNotUsed) + { DumpParsedAstComments.hs:9:5-7 }) + (GRHS + (EpAnn + (Anchor + { DumpParsedAstComments.hs:9:5-7 } + (UnchangedAnchor)) + (GrhsAnn + (Nothing) + (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:9:5 }))) + (EpaComments + [])) + [] + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:7 }) + (HsOverLit + (EpAnn + (Anchor + { DumpParsedAstComments.hs:9:7 } + (UnchangedAnchor)) + (NoEpAnns) + (EpaComments + [])) + (OverLit + (NoExtField) + (HsIntegral + (IL + (SourceText 1) + (False) + (1))))))))] + (EmptyLocalBinds + (NoExtField)))))]))))) + ,(L + (SrcSpanAnn (EpAnn + (Anchor + { DumpParsedAstComments.hs:(14,1)-(16,3) } (UnchangedAnchor)) (AnnListItem []) (EpaComments [(L (Anchor - { DumpParsedAstComments.hs:9:1-20 } + { DumpParsedAstComments.hs:10:1-16 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- Other comment") + { DumpParsedAstComments.hs:9:7 })) + ,(L + (Anchor + { DumpParsedAstComments.hs:12:1-20 } (UnchangedAnchor)) (EpaComment (EpaLineComment "-- comment 1 for foo") - { DumpParsedAstComments.hs:7:1-16 })) + { DumpParsedAstComments.hs:10:1-16 })) ,(L (Anchor - { DumpParsedAstComments.hs:10:1-20 } + { DumpParsedAstComments.hs:13:1-20 } (UnchangedAnchor)) (EpaComment (EpaLineComment "-- comment 2 for foo") - { DumpParsedAstComments.hs:9:1-20 - }))])) { DumpParsedAstComments.hs:(11,1)-(13,3) }) + { DumpParsedAstComments.hs:12:1-20 + }))])) { DumpParsedAstComments.hs:(14,1)-(16,3) }) (ValD (NoExtField) (FunBind (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:11:1-3 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:14:1-3 }) (Unqual {OccName: foo})) (MG (FromSource) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,1)-(13,3) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(14,1)-(16,3) }) [(L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,1)-(13,3) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(14,1)-(16,3) }) (Match (EpAnn (Anchor - { DumpParsedAstComments.hs:(11,1)-(13,3) } + { DumpParsedAstComments.hs:(14,1)-(16,3) } (UnchangedAnchor)) [] (EpaComments [])) (FunRhs (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:11:1-3 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:14:1-3 }) (Unqual {OccName: foo})) (Prefix) @@ -122,72 +214,72 @@ [(L (SrcSpanAnn (EpAnnNotUsed) - { DumpParsedAstComments.hs:(11,5)-(13,3) }) + { DumpParsedAstComments.hs:(14,5)-(16,3) }) (GRHS (EpAnn (Anchor - { DumpParsedAstComments.hs:(11,5)-(13,3) } + { DumpParsedAstComments.hs:(14,5)-(16,3) } (UnchangedAnchor)) (GrhsAnn (Nothing) - (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:11:5 }))) + (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:14:5 }))) (EpaComments [])) [] (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,7)-(13,3) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(14,7)-(16,3) }) (HsDo (EpAnn (Anchor - { DumpParsedAstComments.hs:(11,7)-(13,3) } + { DumpParsedAstComments.hs:(14,7)-(16,3) } (UnchangedAnchor)) (AnnList (Just (Anchor - { DumpParsedAstComments.hs:13:3 } + { DumpParsedAstComments.hs:16:3 } (UnchangedAnchor))) (Nothing) (Nothing) - [(AddEpAnn AnnDo (EpaSpan { DumpParsedAstComments.hs:11:7-8 }))] + [(AddEpAnn AnnDo (EpaSpan { DumpParsedAstComments.hs:14:7-8 }))] []) (EpaComments [(L (Anchor - { DumpParsedAstComments.hs:12:3-19 } + { DumpParsedAstComments.hs:15:3-19 } (UnchangedAnchor)) (EpaComment (EpaLineComment "-- normal comment") - { DumpParsedAstComments.hs:11:7-8 }))])) + { DumpParsedAstComments.hs:14:7-8 }))])) (DoExpr (Nothing)) (L (SrcSpanAnn (EpAnn (Anchor - { DumpParsedAstComments.hs:13:3 } + { DumpParsedAstComments.hs:16:3 } (UnchangedAnchor)) (AnnList (Just (Anchor - { DumpParsedAstComments.hs:13:3 } + { DumpParsedAstComments.hs:16:3 } (UnchangedAnchor))) (Nothing) (Nothing) [] []) (EpaComments - [])) { DumpParsedAstComments.hs:13:3 }) + [])) { DumpParsedAstComments.hs:16:3 }) [(L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:13:3 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:3 }) (BodyStmt (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:13:3 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:3 }) (HsOverLit (EpAnn (Anchor - { DumpParsedAstComments.hs:13:3 } + { DumpParsedAstComments.hs:16:3 } (UnchangedAnchor)) (NoEpAnns) (EpaComments @@ -206,45 +298,45 @@ ,(L (SrcSpanAnn (EpAnn (Anchor - { DumpParsedAstComments.hs:16:1-23 } + { DumpParsedAstComments.hs:19:1-23 } (UnchangedAnchor)) (AnnListItem []) (EpaComments [(L (Anchor - { DumpParsedAstComments.hs:15:1-20 } + { DumpParsedAstComments.hs:18:1-20 } (UnchangedAnchor)) (EpaComment (EpaLineComment "-- | Haddock comment") - { DumpParsedAstComments.hs:13:3 - }))])) { DumpParsedAstComments.hs:16:1-23 }) + { DumpParsedAstComments.hs:16:3 + }))])) { DumpParsedAstComments.hs:19:1-23 }) (ValD (NoExtField) (FunBind (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-4 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-4 }) (Unqual {OccName: main})) (MG (FromSource) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-23 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-23 }) [(L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-23 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-23 }) (Match (EpAnn (Anchor - { DumpParsedAstComments.hs:16:1-23 } + { DumpParsedAstComments.hs:19:1-23 } (UnchangedAnchor)) [] (EpaComments [])) (FunRhs (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-4 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-4 }) (Unqual {OccName: main})) (Prefix) @@ -256,42 +348,42 @@ [(L (SrcSpanAnn (EpAnnNotUsed) - { DumpParsedAstComments.hs:16:6-23 }) + { DumpParsedAstComments.hs:19:6-23 }) (GRHS (EpAnn (Anchor - { DumpParsedAstComments.hs:16:6-23 } + { DumpParsedAstComments.hs:19:6-23 } (UnchangedAnchor)) (GrhsAnn (Nothing) - (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:16:6 }))) + (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:19:6 }))) (EpaComments [])) [] (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-23 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:8-23 }) (HsApp (EpAnn (Anchor - { DumpParsedAstComments.hs:16:8-23 } + { DumpParsedAstComments.hs:19:8-23 } (UnchangedAnchor)) (NoEpAnns) (EpaComments [])) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-15 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:8-15 }) (HsVar (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-15 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:8-15 }) (Unqual {OccName: putStrLn})))) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:17-23 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:17-23 }) (HsLit (EpAnn (Anchor - { DumpParsedAstComments.hs:16:17-23 } + { DumpParsedAstComments.hs:19:17-23 } (UnchangedAnchor)) (NoEpAnns) (EpaComments View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f6f2a65a8200a043c5590ca35fc3a0b36728c5ca -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f6f2a65a8200a043c5590ca35fc3a0b36728c5ca You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 20:19:34 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 07 Feb 2023 15:19:34 -0500 Subject: [Git][ghc/ghc][wip/T22264-9.2] 18 commits: nonmoving: Refactor update remembered set initialization Message-ID: <63e2b2563f010_1108fe772633e8181812d@gitlab.mail> Ben Gamari pushed to branch wip/T22264-9.2 at Glasgow Haskell Compiler / GHC Commits: dc16fb9d by Ben Gamari at 2023-02-07T15:15:52-05:00 nonmoving: Refactor update remembered set initialization This avoids a lock inversion between the storage manager mutex and the stable pointer table mutex by not dropping the SM_MUTEX in nonmovingCollect. This requires quite a bit of rejiggering but it does seem like a better strategy. (cherry picked from commit 543cae0084a72ca767a443d857f9e65a5a79f71d) - - - - - 71598325 by Ben Gamari at 2023-02-07T15:15:52-05:00 nonmoving: Fix style (cherry picked from commit b642ef1dc4cbe19c3479b2c014e7d1f7959f8e4a) - - - - - c25415ad by Ben Gamari at 2023-02-07T15:15:52-05:00 Evac: Squash data race in eval_selector_chain (cherry picked from commit dd784b3b01f076fa7f5715150c53ad4c183ae79d) - - - - - d257683b by Ben Gamari at 2023-02-07T15:15:52-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Likely fixes the cause of #22264. (cherry picked from commit f8988a9c53ae73ff5b9c6008f467a7171e99c61f) - - - - - 61c21925 by Ben Gamari at 2023-02-07T15:15:52-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. (cherry picked from commit a999f7b5b4b7316c088d7233a452fb33dc17646f) - - - - - b8aff76f by Ben Gamari at 2023-02-07T15:15:52-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. (cherry picked from commit 48b89dba91640fa977d038ea5283019c73f1b18e) - - - - - 7e2712e2 by Ben Gamari at 2023-02-07T15:15:52-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive (cherry picked from commit 36ca160d0f199a688cf5fbc91d4bb92d2d4ea14e) - - - - - 8207bdd7 by Ben Gamari at 2023-02-07T15:15:52-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. (cherry picked from commit 8b64aff0fa978c762dfae8df235dd2b2a340656a) - - - - - 0d7d391b by Ben Gamari at 2023-02-07T15:15:52-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. (cherry picked from commit dde67d6e32ecff0e400f98213d42ae790babac09) - - - - - 51a88c78 by Ben Gamari at 2023-02-07T15:15:52-05:00 nonmoving: Don't push if nonmoving collector isn't enabled (cherry picked from commit 8adc1750c02e596b4014d2837b4eb3d76bd130f2) - - - - - 78b668e4 by Ben Gamari at 2023-02-07T15:15:52-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. (cherry picked from commit c620669651c52fd228af61040747dd7236c4ba2b) - - - - - 60ed9dc6 by Ben Gamari at 2023-02-07T15:15:52-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys (cherry picked from commit 3887132fcd20f0a1edfc9f7006bdbed2634e2a8d) - - - - - c468663d by Ben Gamari at 2023-02-07T15:15:52-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. (cherry picked from commit cc75031b4d93d4565e0428cb5910d9b9a645485b) - - - - - 233c6eee by Ben Gamari at 2023-02-07T15:15:53-05:00 nonmoving: Add missing no-op in busy-wait loop (cherry picked from commit 9f931a8801c84b8ae473f91349e144eebc73b415) - - - - - f7a53c2d by Ben Gamari at 2023-02-07T15:15:53-05:00 nonmoving: Move current segment array into Capability (cherry picked from commit 9d245c1baec91ee79d715062b127e487456d9c9e) - - - - - 2e1687da by Ben Gamari at 2023-02-07T15:15:53-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. (cherry picked from commit 6bdce35cdd59112a8cb4a4a3b061e854ada3ff63) - - - - - a7c32488 by Ben Gamari at 2023-02-07T15:15:53-05:00 nonmoving: Fix unregisterised build (cherry picked from commit 6df2709e7215ea80d7267800e0318aee2a7c277f) - - - - - bb7f24a5 by Ben Gamari at 2023-02-07T15:15:53-05:00 nonmoving: Avoid n_caps race (cherry picked from commit c00d6de815d4e125c1c4d8ff06549042f502f759) - - - - - 16 changed files: - rts/Capability.c - rts/Capability.h - rts/PrimOps.cmm - rts/RtsStartup.c - rts/Schedule.c - rts/sm/Evac.c - rts/sm/GC.c - rts/sm/MarkWeak.c - rts/sm/NonMoving.c - rts/sm/NonMoving.h - rts/sm/NonMovingCensus.c - rts/sm/NonMovingCensus.h - rts/sm/NonMovingMark.c - rts/sm/NonMovingMark.h - rts/sm/Sanity.c - rts/sm/Storage.c Changes: ===================================== rts/Capability.c ===================================== @@ -294,6 +294,7 @@ initCapability (Capability *cap, uint32_t i) cap->saved_mut_lists = stgMallocBytes(sizeof(bdescr *) * RtsFlags.GcFlags.generations, "initCapability"); + cap->current_segments = NULL; // At this point storage manager is not initialized yet, so this will be @@ -1267,6 +1268,9 @@ freeCapability (Capability *cap) { stgFree(cap->mut_lists); stgFree(cap->saved_mut_lists); + if (cap->current_segments) { + stgFree(cap->current_segments); + } #if defined(THREADED_RTS) freeSparkPool(cap->sparks); #endif ===================================== rts/Capability.h ===================================== @@ -88,6 +88,9 @@ struct Capability_ { // The update remembered set for the non-moving collector UpdRemSet upd_rem_set; + // Array of current segments for the non-moving collector. + // Of length NONMOVING_ALLOCA_CNT. + struct NonmovingSegment **current_segments; // block for allocating pinned objects into bdescr *pinned_object_block; ===================================== rts/PrimOps.cmm ===================================== @@ -234,9 +234,9 @@ stg_shrinkSmallMutableArrayzh ( gcptr mba, W_ new_size ) p = mba + SIZEOF_StgSmallMutArrPtrs + WDS(new_size); end = mba + SIZEOF_StgSmallMutArrPtrs + WDS(StgSmallMutArrPtrs_ptrs(mba)); again: - ccall updateRemembSetPushClosure_(BaseReg "ptr", - W_[p] "ptr"); if (p < end) { + ccall updateRemembSetPushClosure_(BaseReg "ptr", + W_[p] "ptr"); p = p + SIZEOF_W; goto again; } ===================================== rts/RtsStartup.c ===================================== @@ -472,6 +472,7 @@ hs_exit_(bool wait_foreign) for (g = 0; g < RtsFlags.GcFlags.generations; g++) { runAllCFinalizers(generations[g].weak_ptr_list); } + runAllCFinalizers(nonmoving_weak_ptr_list); #if defined(RTS_USER_SIGNALS) if (RtsFlags.MiscFlags.install_signal_handlers) { ===================================== rts/Schedule.c ===================================== @@ -2306,7 +2306,9 @@ setNumCapabilities (uint32_t new_n_capabilities USED_IF_THREADS) moreCapabilities(n_capabilities, new_n_capabilities); // Resize and update storage manager data structures + ACQUIRE_SM_LOCK; storageAddCapabilities(n_capabilities, new_n_capabilities); + RELEASE_SM_LOCK; } } ===================================== rts/sm/Evac.c ===================================== @@ -1251,8 +1251,13 @@ selector_chain: // save any space in any case, and updating with an indirection is // trickier in a non-collected gen: we would have to update the // mutable list. - if (RELAXED_LOAD(&bd->flags) & (BF_EVACUATED | BF_NONMOVING)) { + uint16_t flags = RELAXED_LOAD(&bd->flags); + if (flags & (BF_EVACUATED | BF_NONMOVING)) { unchain_thunk_selectors(prev_thunk_selector, (StgClosure *)p); + if (flags & BF_NONMOVING) { + // See Note [Non-moving GC: Marking evacuated objects]. + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure*) p); + } *q = (StgClosure *)p; // shortcut, behave as for: if (evac) evacuate(q); if (evac && bd->gen_no < gct->evac_gen_no) { @@ -1267,7 +1272,7 @@ selector_chain: // (scavenge_mark_stack doesn't deal with IND). BEWARE! This // bit is very tricky to get right. If you make changes // around here, test by compiling stage 3 with +RTS -c -RTS. - if (bd->flags & BF_MARKED) { + if (flags & BF_MARKED) { // must call evacuate() to mark this closure if evac==true *q = (StgClosure *)p; if (evac) evacuate(q); @@ -1307,6 +1312,12 @@ selector_chain: // - undo the chain we've built to point to p. SET_INFO((StgClosure *)p, (const StgInfoTable *)info_ptr); RELEASE_STORE(q, (StgClosure *) p); + if (Bdescr((StgPtr)p)->flags & BF_NONMOVING) { + // See Note [Non-moving GC: Marking evacuated objects]. + // TODO: This really shouldn't be necessary since whoever won + // the race should have pushed + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure*) p); + } if (evac) evacuate(q); unchain_thunk_selectors(prev_thunk_selector, (StgClosure *)p); return; @@ -1397,6 +1408,11 @@ selector_loop: case THUNK_SELECTOR: // Use payload to make a list of thunk selectors, to be // used in unchain_thunk_selectors + // + // FIXME: This seems racy; should we lock this selector to + // ensure that another thread doesn't clobber this node + // of the chain. This would result in some previous + // selectors not being updated when we unchain. RELAXED_STORE(&((StgClosure*)p)->payload[0], (StgClosure *)prev_thunk_selector); prev_thunk_selector = p; p = (StgSelector*)val; @@ -1421,6 +1437,12 @@ selector_loop: // eval_thunk_selector(), because we know val is not // a THUNK_SELECTOR. if (evac) evacuate(q); + + if (isNonmovingClosure(*q)) { + // See Note [Non-moving GC: Marking evacuated objects]. + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure*) *q); + } + return; } @@ -1465,6 +1487,10 @@ selector_loop: // recurse indefinitely, so we impose a depth bound. // See Note [Selector optimisation depth limit]. if (gct->thunk_selector_depth >= MAX_THUNK_SELECTOR_DEPTH) { + if (isNonmovingClosure((StgClosure *) p)) { + // See Note [Non-moving GC: Marking evacuated objects]. + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure*) p); + } goto bale_out; } @@ -1511,5 +1537,9 @@ bale_out: if (evac) { copy(q,(const StgInfoTable *)info_ptr,(StgClosure *)p,THUNK_SELECTOR_sizeW(),bd->dest_no); } + if (isNonmovingClosure(*q)) { + // See Note [Non-moving GC: Marking evacuated objects]. + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, *q); + } unchain_thunk_selectors(prev_thunk_selector, *q); } ===================================== rts/sm/GC.c ===================================== @@ -375,7 +375,8 @@ GarbageCollect (uint32_t collect_gen, static_flag == STATIC_FLAG_A ? STATIC_FLAG_B : STATIC_FLAG_A; } - if (major_gc) { + /* N.B. We currently don't unload code with the non-moving collector. */ + if (major_gc && !RtsFlags.GcFlags.useNonmoving) { unload_mark_needed = prepareUnloadCheck(); } else { unload_mark_needed = false; @@ -846,11 +847,9 @@ GarbageCollect (uint32_t collect_gen, // Flush the update remembered sets. See Note [Eager update remembered set // flushing] in NonMovingMark.c if (RtsFlags.GcFlags.useNonmoving) { - RELEASE_SM_LOCK; for (n = 0; n < getNumCapabilities(); n++) { - nonmovingAddUpdRemSetBlocks(&capabilities[n]->upd_rem_set.queue); + nonmovingAddUpdRemSetBlocks(&capabilities[n]->upd_rem_set); } - ACQUIRE_SM_LOCK; } // Mark and sweep the oldest generation. @@ -871,8 +870,6 @@ GarbageCollect (uint32_t collect_gen, // old_weak_ptr_list should be empty. ASSERT(oldest_gen->old_weak_ptr_list == NULL); - // we may need to take the lock to allocate mark queue blocks - RELEASE_SM_LOCK; // dead_weak_ptr_list contains weak pointers with dead keys. Those need to // be kept alive because we'll use them in finalizeSchedulers(). Similarly // resurrected_threads are also going to be used in resurrectedThreads() @@ -882,10 +879,9 @@ GarbageCollect (uint32_t collect_gen, #if !defined(THREADED_RTS) // In the non-threaded runtime this is the only time we push to the // upd_rem_set - nonmovingAddUpdRemSetBlocks(&gct->cap->upd_rem_set.queue); + nonmovingAddUpdRemSetBlocks(&gct->cap->upd_rem_set); #endif nonmovingCollect(&dead_weak_ptr_list, &resurrected_threads); - ACQUIRE_SM_LOCK; } // Update the max size of older generations after a major GC: ===================================== rts/sm/MarkWeak.c ===================================== @@ -50,7 +50,7 @@ - weak_stage == WeakPtrs - We process all the weak pointers whos keys are alive (evacuate + We process all the weak pointers whose keys are alive (evacuate their values and finalizers), and repeat until we can find no new live keys. If no live keys are found in this pass, then we evacuate the finalizers of all the dead weak pointers in order to @@ -82,12 +82,46 @@ static bool tidyWeakList (generation *gen); static bool resurrectUnreachableThreads (generation *gen, StgTSO **resurrected_threads); static void tidyThreadList (generation *gen); +/* + * Note [Weak pointer processing and the non-moving GC] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * When using the non-moving GC we defer weak pointer processing + * until the concurrent marking phase as weaks in the non-moving heap may be + * keyed on objects living in the non-moving generation. To accomplish this + * initWeakForGC keeps all weak pointers on oldest_gen->weak_ptr_list, where + * nonmovingCollect will find them. From there they will be moved to + * nonmoving_old_weak_ptr_list. During the mark loop we will move weaks with + * reachable keys to nonmoving_weak_ptr_list. At the end of concurrent marking + * we tidy the weak list (in nonmovingTidyWeakList) and perform another set of + * marking as necessary, just as is done in tidyWeakList. + * + * Note that this treatment takes advantage of the fact that we usually need + * not worry about Weak#s living in the non-moving heap but being keyed on an + * object in the moving heap since the Weak# must be strictly older than the + * key. Such objects would otherwise pose a problem since the non-moving + * collector would be unable to safely determine the liveness of the key. + * In the rare case that we *do* see such a key (e.g. in the case of a + * pinned ByteArray# living in a partially-filled accumulator block) + * the nonmoving collector assumes that it is live. + * + */ + +/* + * Prepare the weak object lists for GC. Specifically, reset weak_stage + * and move all generations' `weak_ptr_list`s to `old_weak_ptr_list`. + * Weaks with live keys will later be moved back to `weak_ptr_list` by + * `tidyWeakList`. + */ void initWeakForGC(void) { - uint32_t g; + uint32_t oldest = N; + if (RtsFlags.GcFlags.useNonmoving && N == oldest_gen->no) { + // See Note [Weak pointer processing and the non-moving GC]. + oldest = oldest_gen->no - 1; + } - for (g = 0; g <= N; g++) { + for (uint32_t g = 0; g <= oldest; g++) { generation *gen = &generations[g]; gen->old_weak_ptr_list = gen->weak_ptr_list; gen->weak_ptr_list = NULL; @@ -96,6 +130,14 @@ initWeakForGC(void) weak_stage = WeakThreads; } +/* + * Walk the weak pointer lists after having finished a round of scavenging, + * tidying the weak (and possibly thread) lists (depending upon the current + * weak_stage). + * + * Returns true if new live weak pointers were found, implying that another + * round of scavenging is necessary. + */ bool traverseWeakPtrList(StgWeak **dead_weak_ptr_list, StgTSO **resurrected_threads) { @@ -182,6 +224,11 @@ traverseWeakPtrList(StgWeak **dead_weak_ptr_list, StgTSO **resurrected_threads) } } +/* + * Deal with weak pointers with unreachable keys after GC has concluded. + * This means marking the finalizer (and possibly value) in preparation for + * later finalization. + */ static void collectDeadWeakPtrs (generation *gen, StgWeak **dead_weak_ptr_list) { StgWeak *w, *next_w; @@ -198,6 +245,10 @@ static void collectDeadWeakPtrs (generation *gen, StgWeak **dead_weak_ptr_list) } } +/* + * Deal with threads left on the old_threads list after GC has concluded, + * moving them onto the resurrected_threads list where appropriate. + */ static bool resurrectUnreachableThreads (generation *gen, StgTSO **resurrected_threads) { StgTSO *t, *tmp, *next; @@ -233,8 +284,21 @@ static bool resurrectUnreachableThreads (generation *gen, StgTSO **resurrected_t return flag; } +/* + * Walk over the `old_weak_ptr_list` of the given generation and: + * + * - remove any DEAD_WEAKs + * - move any weaks with reachable keys to the `weak_ptr_list` of the + * appropriate to-space and mark the weak's value and finalizer. + */ static bool tidyWeakList(generation *gen) { + if (RtsFlags.GcFlags.useNonmoving && gen == oldest_gen) { + // See Note [Weak pointer processing and the non-moving GC]. + ASSERT(gen->old_weak_ptr_list == NULL); + return false; + } + StgWeak *w, **last_w, *next_w; const StgInfoTable *info; StgClosure *new; @@ -322,6 +386,10 @@ static bool tidyWeakList(generation *gen) return flag; } +/* + * Walk over the `old_threads` list of the given generation and move any + * reachable threads onto the `threads` list. + */ static void tidyThreadList (generation *gen) { StgTSO *t, *tmp, *next, **prev; @@ -381,6 +449,10 @@ static void checkWeakPtrSanity(StgWeak *hd, StgWeak *tl) } #endif +/* + * Traverse the capabilities' local new-weak-pointer lists at the beginning of + * GC and move them to the nursery's weak_ptr_list. + */ void collectFreshWeakPtrs() { uint32_t i; ===================================== rts/sm/NonMoving.c ===================================== @@ -244,6 +244,12 @@ Mutex concurrent_coll_finished_lock; * how we use the DIRTY flags associated with MUT_VARs and TVARs to improve * barrier efficiency. * + * - Note [Weak pointer processing and the non-moving GC] (MarkWeak.c) describes + * how weak pointers are handled when the non-moving GC is in use. + * + * - Note [Sync phase marking budget] describes how we avoid long mutator + * pauses during the sync phase + * * [ueno 2016]: * Katsuhiro Ueno and Atsushi Ohori. 2016. A fully concurrent garbage * collector for functional programs on multicore processors. SIGPLAN Not. 51, @@ -292,6 +298,7 @@ Mutex concurrent_coll_finished_lock; * ┆ * B ←────────────── A ←─────────────── root * │ ┆ ↖─────────────── gen1 mut_list + * │ ┆ * ╰───────────────→ C * ┆ * @@ -332,6 +339,7 @@ Mutex concurrent_coll_finished_lock; * The implementation details of this are described in Note [Non-moving GC: * Marking evacuated objects] in Evac.c. * + * * Note [Deadlock detection under the non-moving collector] * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ * In GHC the garbage collector is responsible for identifying deadlocked @@ -493,10 +501,44 @@ Mutex concurrent_coll_finished_lock; * remembered set during the preparatory GC. This allows us to safely skip the * non-moving write barrier without jeopardizing the snapshot invariant. * + * + * Note [Sync phase marking budget] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * The non-moving collector is intended to provide reliably low collection + * latencies. These latencies are primarily due to two sources: + * + * a. the preparatory moving collection at the beginning of the major GC cycle + * b. the post-mark synchronization pause at the end + * + * While the cost of (a) is inherently bounded by the young generation size, + * (b) can in principle be unbounded since the mutator may hide large swathes + * of heap from the collector's concurrent mark phase via mutation. These will + * only become visible to the collector during the post-mark synchronization + * phase. + * + * Since we don't want to do unbounded marking work in the pause, we impose a + * limit (specifically, sync_phase_marking_budget) on the amount of work + * (namely, the number of marked closures) that we can do during the pause. If + * we deplete our marking budget during the pause then we allow the mutators to + * resume and return to concurrent marking (keeping the update remembered set + * write barrier enabled). After we have finished marking we will again + * attempt the post-mark synchronization. + * + * The choice of sync_phase_marking_budget was made empirically. On 2022 + * hardware and a "typical" test program we tend to mark ~10^7 closures per + * second. Consequently, a sync_phase_marking_budget of 10^5 should produce + * ~10 ms pauses, which seems like a reasonable tradeoff. + * + * TODO: Perhaps sync_phase_marking_budget should be controllable via a + * command-line argument? + * */ memcount nonmoving_live_words = 0; +// See Note [Sync phase marking budget]. +MarkBudget sync_phase_marking_budget = 200000; + #if defined(THREADED_RTS) static void* nonmovingConcurrentMark(void *mark_queue); #endif @@ -665,10 +707,11 @@ void *nonmovingAllocate(Capability *cap, StgWord sz) // object and not moved) which is covered by allocator 9. ASSERT(log_block_size < NONMOVING_ALLOCA0 + NONMOVING_ALLOCA_CNT); - struct NonmovingAllocator *alloca = nonmovingHeap.allocators[log_block_size - NONMOVING_ALLOCA0]; + unsigned int alloca_idx = log_block_size - NONMOVING_ALLOCA0; + struct NonmovingAllocator *alloca = &nonmovingHeap.allocators[alloca_idx]; // Allocate into current segment - struct NonmovingSegment *current = alloca->current[cap->no]; + struct NonmovingSegment *current = cap->current_segments[alloca_idx]; ASSERT(current); // current is never NULL void *ret = nonmovingSegmentGetBlock_(current, log_block_size, current->next_free); ASSERT(GET_CLOSURE_TAG(ret) == 0); // check alignment @@ -701,29 +744,12 @@ void *nonmovingAllocate(Capability *cap, StgWord sz) // make it current new_current->link = NULL; SET_SEGMENT_STATE(new_current, CURRENT); - alloca->current[cap->no] = new_current; + cap->current_segments[alloca_idx] = new_current; } return ret; } -/* Allocate a nonmovingAllocator */ -static struct NonmovingAllocator *alloc_nonmoving_allocator(uint32_t n_caps) -{ - size_t allocator_sz = - sizeof(struct NonmovingAllocator) + - sizeof(void*) * n_caps; // current segment pointer for each capability - struct NonmovingAllocator *alloc = - stgMallocBytes(allocator_sz, "nonmovingInit"); - memset(alloc, 0, allocator_sz); - return alloc; -} - -static void free_nonmoving_allocator(struct NonmovingAllocator *alloc) -{ - stgFree(alloc); -} - void nonmovingInit(void) { if (! RtsFlags.GcFlags.useNonmoving) return; @@ -732,10 +758,7 @@ void nonmovingInit(void) initCondition(&concurrent_coll_finished); initMutex(&concurrent_coll_finished_lock); #endif - for (unsigned int i = 0; i < NONMOVING_ALLOCA_CNT; i++) { - nonmovingHeap.allocators[i] = alloc_nonmoving_allocator(getNumCapabilities()); - } - nonmovingMarkInitUpdRemSet(); + nonmovingMarkInit(); } // Stop any nonmoving collection in preparation for RTS shutdown. @@ -764,44 +787,24 @@ void nonmovingExit(void) closeCondition(&concurrent_coll_finished); closeMutex(&nonmoving_collection_mutex); #endif - - for (unsigned int i = 0; i < NONMOVING_ALLOCA_CNT; i++) { - free_nonmoving_allocator(nonmovingHeap.allocators[i]); - } } -/* - * Assumes that no garbage collector or mutator threads are running to safely - * resize the nonmoving_allocators. - * - * Must hold sm_mutex. - */ -void nonmovingAddCapabilities(uint32_t new_n_caps) +/* Initialize a new capability. Caller must hold SM_LOCK */ +void nonmovingInitCapability(Capability *cap) { - unsigned int old_n_caps = nonmovingHeap.n_caps; - struct NonmovingAllocator **allocs = nonmovingHeap.allocators; - + // Initialize current segment array + struct NonmovingSegment **segs = + stgMallocBytes(sizeof(struct NonmovingSegment*) * NONMOVING_ALLOCA_CNT, "current segment array"); for (unsigned int i = 0; i < NONMOVING_ALLOCA_CNT; i++) { - struct NonmovingAllocator *old = allocs[i]; - allocs[i] = alloc_nonmoving_allocator(new_n_caps); - - // Copy the old state - allocs[i]->filled = old->filled; - allocs[i]->active = old->active; - for (unsigned int j = 0; j < old_n_caps; j++) { - allocs[i]->current[j] = old->current[j]; - } - stgFree(old); - - // Initialize current segments for the new capabilities - for (unsigned int j = old_n_caps; j < new_n_caps; j++) { - allocs[i]->current[j] = nonmovingAllocSegment(capabilities[j]->node); - nonmovingInitSegment(allocs[i]->current[j], NONMOVING_ALLOCA0 + i); - SET_SEGMENT_STATE(allocs[i]->current[j], CURRENT); - allocs[i]->current[j]->link = NULL; - } + segs[i] = nonmovingAllocSegment(cap->node); + nonmovingInitSegment(segs[i], NONMOVING_ALLOCA0 + i); + SET_SEGMENT_STATE(segs[i], CURRENT); } - nonmovingHeap.n_caps = new_n_caps; + cap->current_segments = segs; + + // Initialize update remembered set + cap->upd_rem_set.queue.blocks = NULL; + nonmovingInitUpdRemSet(&cap->upd_rem_set); } void nonmovingClearBitmap(struct NonmovingSegment *seg) @@ -821,18 +824,21 @@ static void nonmovingPrepareMark(void) // Should have been cleared by the last sweep ASSERT(nonmovingHeap.sweep_list == NULL); + nonmovingHeap.n_caps = n_capabilities; nonmovingBumpEpoch(); for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { - struct NonmovingAllocator *alloca = nonmovingHeap.allocators[alloca_idx]; + struct NonmovingAllocator *alloca = &nonmovingHeap.allocators[alloca_idx]; // Update current segments' snapshot pointers - for (uint32_t cap_n = 0; cap_n < getNumCapabilities(); ++cap_n) { - struct NonmovingSegment *seg = alloca->current[cap_n]; + for (uint32_t cap_n = 0; cap_n < nonmovingHeap.n_caps; ++cap_n) { + Capability *cap = capabilities[cap_n]; + struct NonmovingSegment *seg = cap->current_segments[alloca_idx]; nonmovingSegmentInfo(seg)->next_free_snap = seg->next_free; } // Save the filled segments for later processing during the concurrent // mark phase. + ASSERT(alloca->saved_filled == NULL); alloca->saved_filled = alloca->filled; alloca->filled = NULL; @@ -886,37 +892,6 @@ static void nonmovingPrepareMark(void) #endif } -// Mark weak pointers in the non-moving heap. They'll either end up in -// dead_weak_ptr_list or stay in weak_ptr_list. Either way they need to be kept -// during sweep. See `MarkWeak.c:markWeakPtrList` for the moving heap variant -// of this. -static void nonmovingMarkWeakPtrList(MarkQueue *mark_queue, StgWeak *dead_weak_ptr_list) -{ - for (StgWeak *w = oldest_gen->weak_ptr_list; w; w = w->link) { - markQueuePushClosure_(mark_queue, (StgClosure*)w); - // Do not mark finalizers and values here, those fields will be marked - // in `nonmovingMarkDeadWeaks` (for dead weaks) or - // `nonmovingTidyWeaks` (for live weaks) - } - - // We need to mark dead_weak_ptr_list too. This is subtle: - // - // - By the beginning of this GC we evacuated all weaks to the non-moving - // heap (in `markWeakPtrList`) - // - // - During the scavenging of the moving heap we discovered that some of - // those weaks are dead and moved them to `dead_weak_ptr_list`. Note that - // because of the fact above _all weaks_ are in the non-moving heap at - // this point. - // - // - So, to be able to traverse `dead_weak_ptr_list` and run finalizers we - // need to mark it. - for (StgWeak *w = dead_weak_ptr_list; w; w = w->link) { - markQueuePushClosure_(mark_queue, (StgClosure*)w); - nonmovingMarkDeadWeak(mark_queue, w); - } -} - void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) { #if defined(THREADED_RTS) @@ -939,6 +914,7 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) ASSERT(n_nonmoving_marked_compact_blocks == 0); MarkQueue *mark_queue = stgMallocBytes(sizeof(MarkQueue), "mark queue"); + mark_queue->blocks = NULL; initMarkQueue(mark_queue); current_mark_queue = mark_queue; @@ -950,12 +926,19 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) capabilities[n], true/*don't mark sparks*/); } markScheduler((evac_fn)markQueueAddRoot, mark_queue); - nonmovingMarkWeakPtrList(mark_queue, *dead_weaks); markStablePtrTable((evac_fn)markQueueAddRoot, mark_queue); + // The dead weak pointer list shouldn't contain any weaks in the + // nonmoving heap +#if defined(DEBUG) + for (StgWeak *w = *dead_weaks; w; w = w->link) { + ASSERT(Bdescr((StgPtr) w)->gen != oldest_gen); + } +#endif + // Mark threads resurrected during moving heap scavenging for (StgTSO *tso = *resurrected_threads; tso != END_TSO_QUEUE; tso = tso->global_link) { - markQueuePushClosure_(mark_queue, (StgClosure*)tso); + markQueuePushClosureGC(mark_queue, (StgClosure*)tso); } trace(TRACE_nonmoving_gc, "Finished marking roots for nonmoving GC"); @@ -978,8 +961,23 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) // alive). ASSERT(oldest_gen->old_weak_ptr_list == NULL); ASSERT(nonmoving_old_weak_ptr_list == NULL); - nonmoving_old_weak_ptr_list = oldest_gen->weak_ptr_list; - oldest_gen->weak_ptr_list = NULL; + { + // Move both oldest_gen->weak_ptr_list and nonmoving_weak_ptr_list to + // nonmoving_old_weak_ptr_list + StgWeak **weaks = &oldest_gen->weak_ptr_list; + uint32_t n = 0; + while (*weaks) { + weaks = &(*weaks)->link; + n++; + } + debugTrace(DEBUG_nonmoving_gc, "%d new nonmoving weaks", n); + *weaks = nonmoving_weak_ptr_list; + nonmoving_old_weak_ptr_list = oldest_gen->weak_ptr_list; + nonmoving_weak_ptr_list = NULL; + oldest_gen->weak_ptr_list = NULL; + // At this point all weaks in the nonmoving generation are on + // nonmoving_old_weak_ptr_list + } trace(TRACE_nonmoving_gc, "Finished nonmoving GC preparation"); // We are now safe to start concurrent marking @@ -1015,19 +1013,25 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) } /* Mark queue, threads, and weak pointers until no more weaks have been - * resuscitated + * resuscitated. If *budget is non-zero then we will mark no more than + * Returns true if we there is no more marking work to be done, false if + * we exceeded our marking budget. */ -static void nonmovingMarkThreadsWeaks(MarkQueue *mark_queue) +static bool nonmovingMarkThreadsWeaks(MarkBudget *budget, MarkQueue *mark_queue) { while (true) { // Propagate marks - nonmovingMark(mark_queue); + nonmovingMark(budget, mark_queue); + if (*budget == 0) { + return false; + } // Tidy threads and weaks nonmovingTidyThreads(); - if (! nonmovingTidyWeaks(mark_queue)) - return; + if (! nonmovingTidyWeaks(mark_queue)) { + return true; + } } } @@ -1041,7 +1045,6 @@ static void* nonmovingConcurrentMark(void *data) return NULL; } -// TODO: Not sure where to put this function. // Append w2 to the end of w1. static void appendWeakList( StgWeak **w1, StgWeak *w2 ) { @@ -1061,28 +1064,40 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * // Walk the list of filled segments that we collected during preparation, // updated their snapshot pointers and move them to the sweep list. for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { - struct NonmovingSegment *filled = nonmovingHeap.allocators[alloca_idx]->saved_filled; + struct NonmovingSegment *filled = nonmovingHeap.allocators[alloca_idx].saved_filled; uint32_t n_filled = 0; if (filled) { struct NonmovingSegment *seg = filled; while (true) { // Set snapshot nonmovingSegmentInfo(seg)->next_free_snap = seg->next_free; + SET_SEGMENT_STATE(seg, FILLED_SWEEPING); n_filled++; - if (seg->link) + if (seg->link) { seg = seg->link; - else + } else { break; + } } // add filled segments to sweep_list - SET_SEGMENT_STATE(seg, FILLED_SWEEPING); seg->link = nonmovingHeap.sweep_list; nonmovingHeap.sweep_list = filled; } + nonmovingHeap.allocators[alloca_idx].saved_filled = NULL; } + // Mark Weak#s + nonmovingMarkWeakPtrList(mark_queue); + // Do concurrent marking; most of the heap will get marked here. - nonmovingMarkThreadsWeaks(mark_queue); + +#if defined(THREADED_RTS) +concurrent_marking: +#endif + { + MarkBudget budget = UNLIMITED_MARK_BUDGET; + nonmovingMarkThreadsWeaks(&budget, mark_queue); + } #if defined(THREADED_RTS) Task *task = newBoundTask(); @@ -1091,21 +1106,13 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * if (sched_state > SCHED_RUNNING) { // Note that we break our invariants here and leave segments in // nonmovingHeap.sweep_list, don't free nonmoving_large_objects etc. - // However because we won't be running mark-sweep in the final GC this + // However because we won't be running sweep in the final GC this // is OK. - - // This is a RTS shutdown so we need to move our copy (snapshot) of - // weaks (nonmoving_old_weak_ptr_list and nonmoving_weak_ptr_list) to - // oldest_gen->threads to be able to run C finalizers in hs_exit_. Note - // that there may be more weaks added to oldest_gen->threads since we - // started mark, so we need to append our list to the tail of - // oldest_gen->threads. - appendWeakList(&nonmoving_old_weak_ptr_list, nonmoving_weak_ptr_list); - appendWeakList(&oldest_gen->weak_ptr_list, nonmoving_old_weak_ptr_list); - // These lists won't be used again so this is not necessary, but still - nonmoving_old_weak_ptr_list = NULL; - nonmoving_weak_ptr_list = NULL; - + // + // However, we must move any weak pointers remaining on + // nonmoving_old_weak_ptr_list back to nonmoving_weak_ptr_list + // such that their C finalizers can be run by hs_exit_. + appendWeakList(&nonmoving_weak_ptr_list, nonmoving_old_weak_ptr_list); goto finish; } @@ -1113,9 +1120,17 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * nonmovingBeginFlush(task); bool all_caps_syncd; + MarkBudget sync_marking_budget = sync_phase_marking_budget; do { all_caps_syncd = nonmovingWaitForFlush(); - nonmovingMarkThreadsWeaks(mark_queue); + if (nonmovingMarkThreadsWeaks(&sync_marking_budget, mark_queue) == false) { + // We ran out of budget for marking. Abort sync. + // See Note [Sync phase marking budget]. + traceConcSyncEnd(); + stat_endNonmovingGcSync(); + releaseAllCapabilities(n_capabilities, NULL, task); + goto concurrent_marking; + } } while (!all_caps_syncd); #endif @@ -1126,7 +1141,7 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * // Do last marking of weak pointers while (true) { // Propagate marks - nonmovingMark(mark_queue); + nonmovingMarkUnlimitedBudget(mark_queue); if (!nonmovingTidyWeaks(mark_queue)) break; @@ -1135,7 +1150,7 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * nonmovingMarkDeadWeaks(mark_queue, dead_weaks); // Propagate marks - nonmovingMark(mark_queue); + nonmovingMarkUnlimitedBudget(mark_queue); // Now remove all dead objects from the mut_list to ensure that a younger // generation collection doesn't attempt to look at them after we've swept. @@ -1177,15 +1192,9 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * nonmoving_old_threads = END_TSO_QUEUE; } - { - StgWeak **weaks = &oldest_gen->weak_ptr_list; - while (*weaks) { - weaks = &(*weaks)->link; - } - *weaks = nonmoving_weak_ptr_list; - nonmoving_weak_ptr_list = NULL; - nonmoving_old_weak_ptr_list = NULL; - } + // At this point point any weak that remains on nonmoving_old_weak_ptr_list + // has a dead key. + nonmoving_old_weak_ptr_list = NULL; // Prune spark lists // See Note [Spark management under the nonmoving collector]. @@ -1283,10 +1292,12 @@ void assert_in_nonmoving_heap(StgPtr p) } for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { - struct NonmovingAllocator *alloca = nonmovingHeap.allocators[alloca_idx]; + struct NonmovingAllocator *alloca = &nonmovingHeap.allocators[alloca_idx]; + // Search current segments - for (uint32_t cap_idx = 0; cap_idx < getNumCapabilities(); ++cap_idx) { - struct NonmovingSegment *seg = alloca->current[cap_idx]; + for (uint32_t cap_idx = 0; cap_idx < nonmovingHeap.n_caps; ++cap_idx) { + Capability *cap = capabilities[cap_idx]; + struct NonmovingSegment *seg = cap->current_segments[alloca_idx]; if (p >= (P_)seg && p < (((P_)seg) + NONMOVING_SEGMENT_SIZE_W)) { return; } @@ -1345,33 +1356,16 @@ void nonmovingPrintSegment(struct NonmovingSegment *seg) debugBelch("End of segment\n\n"); } -void nonmovingPrintAllocator(struct NonmovingAllocator *alloc) -{ - debugBelch("Allocator at %p\n", (void*)alloc); - debugBelch("Filled segments:\n"); - for (struct NonmovingSegment *seg = alloc->filled; seg != NULL; seg = seg->link) { - debugBelch("%p ", (void*)seg); - } - debugBelch("\nActive segments:\n"); - for (struct NonmovingSegment *seg = alloc->active; seg != NULL; seg = seg->link) { - debugBelch("%p ", (void*)seg); - } - debugBelch("\nCurrent segments:\n"); - for (uint32_t i = 0; i < getNumCapabilities(); ++i) { - debugBelch("%p ", alloc->current[i]); - } - debugBelch("\n"); -} - void locate_object(P_ obj) { // Search allocators for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { - struct NonmovingAllocator *alloca = nonmovingHeap.allocators[alloca_idx]; - for (uint32_t cap = 0; cap < getNumCapabilities(); ++cap) { - struct NonmovingSegment *seg = alloca->current[cap]; + struct NonmovingAllocator *alloca = &nonmovingHeap.allocators[alloca_idx]; + for (uint32_t cap_n = 0; cap_n < nonmovingHeap.n_caps; ++cap_n) { + Capability *cap = capabilities[cap_n]; + struct NonmovingSegment *seg = cap->current_segments[alloca_idx]; if (obj >= (P_)seg && obj < (((P_)seg) + NONMOVING_SEGMENT_SIZE_W)) { - debugBelch("%p is in current segment of capability %d of allocator %d at %p\n", obj, cap, alloca_idx, (void*)seg); + debugBelch("%p is in current segment of capability %d of allocator %d at %p\n", obj, cap_n, alloca_idx, (void*)seg); return; } } ===================================== rts/sm/NonMoving.h ===================================== @@ -84,8 +84,7 @@ struct NonmovingAllocator { struct NonmovingSegment *filled; struct NonmovingSegment *saved_filled; struct NonmovingSegment *active; - // indexed by capability number - struct NonmovingSegment *current[]; + // N.B. Per-capabilty "current" segment lives in Capability }; // first allocator is of size 2^NONMOVING_ALLOCA0 (in bytes) @@ -99,7 +98,7 @@ struct NonmovingAllocator { #define NONMOVING_MAX_FREE 16 struct NonmovingHeap { - struct NonmovingAllocator *allocators[NONMOVING_ALLOCA_CNT]; + struct NonmovingAllocator allocators[NONMOVING_ALLOCA_CNT]; // free segment list. This is a cache where we keep up to // NONMOVING_MAX_FREE segments to avoid thrashing the block allocator. // Note that segments in this list are still counted towards @@ -149,7 +148,7 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads); void *nonmovingAllocate(Capability *cap, StgWord sz); -void nonmovingAddCapabilities(uint32_t new_n_caps); +void nonmovingInitCapability(Capability *cap); void nonmovingPushFreeSegment(struct NonmovingSegment *seg); void nonmovingClearBitmap(struct NonmovingSegment *seg); @@ -166,7 +165,7 @@ INLINE_HEADER uint8_t nonmovingSegmentLogBlockSize(struct NonmovingSegment *seg) INLINE_HEADER void nonmovingPushActiveSegment(struct NonmovingSegment *seg) { struct NonmovingAllocator *alloc = - nonmovingHeap.allocators[nonmovingSegmentLogBlockSize(seg) - NONMOVING_ALLOCA0]; + &nonmovingHeap.allocators[nonmovingSegmentLogBlockSize(seg) - NONMOVING_ALLOCA0]; SET_SEGMENT_STATE(seg, ACTIVE); while (true) { struct NonmovingSegment *current_active = (struct NonmovingSegment*)VOLATILE_LOAD(&alloc->active); @@ -181,7 +180,7 @@ INLINE_HEADER void nonmovingPushActiveSegment(struct NonmovingSegment *seg) INLINE_HEADER void nonmovingPushFilledSegment(struct NonmovingSegment *seg) { struct NonmovingAllocator *alloc = - nonmovingHeap.allocators[nonmovingSegmentLogBlockSize(seg) - NONMOVING_ALLOCA0]; + &nonmovingHeap.allocators[nonmovingSegmentLogBlockSize(seg) - NONMOVING_ALLOCA0]; SET_SEGMENT_STATE(seg, FILLED); while (true) { struct NonmovingSegment *current_filled = (struct NonmovingSegment*)VOLATILE_LOAD(&alloc->filled); @@ -289,20 +288,17 @@ INLINE_HEADER void nonmovingSetClosureMark(StgPtr p) nonmovingSetMark(nonmovingGetSegment(p), nonmovingGetBlockIdx(p)); } -// TODO: Audit the uses of these -/* Was the given closure marked this major GC cycle? */ -INLINE_HEADER bool nonmovingClosureMarkedThisCycle(StgPtr p) +INLINE_HEADER uint8_t nonmovingGetClosureMark(StgPtr p) { struct NonmovingSegment *seg = nonmovingGetSegment(p); nonmoving_block_idx blk_idx = nonmovingGetBlockIdx(p); - return nonmovingGetMark(seg, blk_idx) == nonmovingMarkEpoch; + return nonmovingGetMark(seg, blk_idx); } -INLINE_HEADER bool nonmovingClosureMarked(StgPtr p) +/* Was the given closure marked this major GC cycle? */ +INLINE_HEADER bool nonmovingClosureMarkedThisCycle(StgPtr p) { - struct NonmovingSegment *seg = nonmovingGetSegment(p); - nonmoving_block_idx blk_idx = nonmovingGetBlockIdx(p); - return nonmovingGetMark(seg, blk_idx) != 0; + return nonmovingGetClosureMark(p) == nonmovingMarkEpoch; } // Can be called during a major collection to determine whether a particular @@ -336,10 +332,14 @@ INLINE_HEADER bool nonmovingClosureBeingSwept(StgClosure *p) } } +// N.B. RtsFlags is defined as a pointer in STG code consequently this code +// doesn't typecheck. +#if !IN_STG_CODE INLINE_HEADER bool isNonmovingClosure(StgClosure *p) { - return !HEAP_ALLOCED_GC(p) || Bdescr((P_)p)->flags & BF_NONMOVING; + return RtsFlags.GcFlags.useNonmoving && (!HEAP_ALLOCED_GC(p) || Bdescr((P_)p)->flags & BF_NONMOVING); } +#endif #if defined(DEBUG) ===================================== rts/sm/NonMovingCensus.c ===================================== @@ -21,10 +21,12 @@ // stopped. In this case is safe to look at active and current segments so we can // also collect statistics on live words. static struct NonmovingAllocCensus -nonmovingAllocatorCensus_(struct NonmovingAllocator *alloc, bool collect_live_words) +nonmovingAllocatorCensus_(uint32_t alloc_idx, bool collect_live_words) { struct NonmovingAllocCensus census = {collect_live_words, 0, 0, 0, 0}; + struct NonmovingAllocator *alloc = &nonmovingHeap.allocators[alloc_idx]; + // filled segments for (struct NonmovingSegment *seg = alloc->filled; seg != NULL; seg = seg->link) @@ -40,6 +42,7 @@ nonmovingAllocatorCensus_(struct NonmovingAllocator *alloc, bool collect_live_wo } } + // active segments for (struct NonmovingSegment *seg = alloc->active; seg != NULL; seg = seg->link) @@ -56,9 +59,11 @@ nonmovingAllocatorCensus_(struct NonmovingAllocator *alloc, bool collect_live_wo } } - for (unsigned int cap=0; cap < getNumCapabilities(); cap++) + // current segments + for (unsigned int cap_n=0; cap_n < getNumCapabilities(); cap_n++) { - struct NonmovingSegment *seg = alloc->current[cap]; + Capability *cap = capabilities[cap_n]; + struct NonmovingSegment *seg = cap->current_segments[alloc_idx]; unsigned int n = nonmovingSegmentBlockCount(seg); for (unsigned int i=0; i < n; i++) { if (nonmovingGetMark(seg, i)) { @@ -76,15 +81,15 @@ nonmovingAllocatorCensus_(struct NonmovingAllocator *alloc, bool collect_live_wo * all blocks in nonmoving heap are valid closures. */ struct NonmovingAllocCensus -nonmovingAllocatorCensusWithWords(struct NonmovingAllocator *alloc) +nonmovingAllocatorCensusWithWords(uint32_t alloc_idx) { - return nonmovingAllocatorCensus_(alloc, true); + return nonmovingAllocatorCensus_(alloc_idx, true); } struct NonmovingAllocCensus -nonmovingAllocatorCensus(struct NonmovingAllocator *alloc) +nonmovingAllocatorCensus(uint32_t alloc_idx) { - return nonmovingAllocatorCensus_(alloc, false); + return nonmovingAllocatorCensus_(alloc_idx, false); } @@ -130,7 +135,7 @@ void nonmovingPrintAllocatorCensus(bool collect_live_words) for (int i=0; i < NONMOVING_ALLOCA_CNT; i++) { struct NonmovingAllocCensus census = - nonmovingAllocatorCensus_(nonmovingHeap.allocators[i], collect_live_words); + nonmovingAllocatorCensus_(i, collect_live_words); print_alloc_census(i, census); } @@ -143,8 +148,7 @@ void nonmovingTraceAllocatorCensus() return; for (int i=0; i < NONMOVING_ALLOCA_CNT; i++) { - const struct NonmovingAllocCensus census = - nonmovingAllocatorCensus(nonmovingHeap.allocators[i]); + const struct NonmovingAllocCensus census = nonmovingAllocatorCensus(i); const uint32_t log_blk_size = i + NONMOVING_ALLOCA0; traceNonmovingHeapCensus(log_blk_size, &census); } ===================================== rts/sm/NonMovingCensus.h ===================================== @@ -20,10 +20,10 @@ struct NonmovingAllocCensus { struct NonmovingAllocCensus -nonmovingAllocatorCensusWithWords(struct NonmovingAllocator *alloc); +nonmovingAllocatorCensusWithWords(uint32_t alloc_idx); struct NonmovingAllocCensus -nonmovingAllocatorCensus(struct NonmovingAllocator *alloc); +nonmovingAllocatorCensus(uint32_t alloc_idx); void nonmovingPrintAllocatorCensus(bool collect_live_words); void nonmovingTraceAllocatorCensus(void); ===================================== rts/sm/NonMovingMark.c ===================================== @@ -27,6 +27,8 @@ #include "sm/Storage.h" #include "CNF.h" +static void nonmovingResetUpdRemSetQueue (MarkQueue *rset); +static void nonmovingResetUpdRemSet (UpdRemSet *rset); static bool check_in_nonmoving_heap(StgClosure *p); static void mark_closure (MarkQueue *queue, const StgClosure *p, StgClosure **origin); static void trace_tso (MarkQueue *queue, StgTSO *tso); @@ -35,6 +37,7 @@ static void trace_PAP_payload (MarkQueue *queue, StgClosure *fun, StgClosure **payload, StgWord size); +static bool is_nonmoving_weak(StgWeak *weak); // How many Array# entries to add to the mark queue at once? #define MARK_ARRAY_CHUNK_LENGTH 128 @@ -250,7 +253,7 @@ StgWord nonmoving_write_barrier_enabled = false; MarkQueue *current_mark_queue = NULL; /* Initialise update remembered set data structures */ -void nonmovingMarkInitUpdRemSet() { +void nonmovingMarkInit() { #if defined(THREADED_RTS) initMutex(&upd_rem_set_lock); initCondition(&upd_rem_set_flushed_cond); @@ -263,33 +266,57 @@ static uint32_t markQueueLength(MarkQueue *q); #endif static void init_mark_queue_(MarkQueue *queue); -/* Transfers the given capability's update-remembered set to the global - * remembered set. - * - * Really the argument type should be UpdRemSet* but this would be rather - * inconvenient without polymorphism. - */ -void nonmovingAddUpdRemSetBlocks(MarkQueue *rset) +static void nonmovingAddUpdRemSetBlocks_(MarkQueue *rset) { - if (markQueueIsEmpty(rset)) return; - - // find the tail of the queue + // find the tail of the remembered set mark queue bdescr *start = rset->blocks; bdescr *end = start; while (end->link != NULL) end = end->link; + rset->blocks = NULL; // add the blocks to the global remembered set ACQUIRE_LOCK(&upd_rem_set_lock); end->link = upd_rem_set_block_list; upd_rem_set_block_list = start; RELEASE_LOCK(&upd_rem_set_lock); +} - // Reset remembered set +/* + * Transfers the given capability's update-remembered set to the global + * remembered set. + * + * Really the argument type should be UpdRemSet* but this would be rather + * inconvenient without polymorphism. + */ +static void nonmovingAddUpdRemSetBlocks_lock(MarkQueue *rset) +{ + if (markQueueIsEmpty(rset)) return; + + nonmovingAddUpdRemSetBlocks_(rset); + // Reset the state of the remembered set. ACQUIRE_SM_LOCK; init_mark_queue_(rset); - rset->is_upd_rem_set = true; RELEASE_SM_LOCK; + rset->is_upd_rem_set = true; +} + +/* + * Transfers the given capability's update-remembered set to the global + * remembered set. + * + * Really the argument type should be UpdRemSet* but this would be rather + * inconvenient without polymorphism. + * + * Caller must hold SM_LOCK. + */ +void nonmovingAddUpdRemSetBlocks(UpdRemSet *rset) +{ + if (markQueueIsEmpty(&rset->queue)) return; + + nonmovingAddUpdRemSetBlocks_(&rset->queue); + init_mark_queue_(&rset->queue); + rset->queue.is_upd_rem_set = true; } #if defined(THREADED_RTS) @@ -303,7 +330,7 @@ void nonmovingFlushCapUpdRemSetBlocks(Capability *cap) "Capability %d flushing update remembered set: %d", cap->no, markQueueLength(&cap->upd_rem_set.queue)); traceConcUpdRemSetFlush(cap); - nonmovingAddUpdRemSetBlocks(&cap->upd_rem_set.queue); + nonmovingAddUpdRemSetBlocks_lock(&cap->upd_rem_set.queue); atomic_inc(&upd_rem_set_flush_count, 1); signalCondition(&upd_rem_set_flushed_cond); // After this mutation will remain suspended until nonmovingFinishFlush @@ -401,7 +428,7 @@ void nonmovingFinishFlush(Task *task) { // See Note [Unintentional marking in resurrectThreads] for (uint32_t i = 0; i < getNumCapabilities(); i++) { - reset_upd_rem_set(&capabilities[i]->upd_rem_set); + nonmovingResetUpdRemSet(&capabilities[i]->upd_rem_set); } // Also reset upd_rem_set_block_list in case some of the UpdRemSets were // filled and we flushed them. @@ -426,7 +453,8 @@ push (MarkQueue *q, const MarkQueueEnt *ent) if (q->top->head == MARK_QUEUE_BLOCK_ENTRIES) { // Yes, this block is full. if (q->is_upd_rem_set) { - nonmovingAddUpdRemSetBlocks(q); + // Flush the block to the global update remembered set + nonmovingAddUpdRemSetBlocks_lock(q); } else { // allocate a fresh block. ACQUIRE_SM_LOCK; @@ -623,6 +651,16 @@ void updateRemembSetPushThunkEager(Capability *cap, } break; } + case THUNK_SELECTOR: + { + StgSelector *sel = (StgSelector *) thunk; + if (check_in_nonmoving_heap(sel->selectee)) { + // Don't bother to push origin; it makes the barrier needlessly + // expensive with little benefit. + push_closure(queue, sel->selectee, NULL); + } + break; + } case AP: { StgAP *ap = (StgAP *) thunk; @@ -632,9 +670,11 @@ void updateRemembSetPushThunkEager(Capability *cap, trace_PAP_payload(queue, ap->fun, ap->payload, ap->n_args); break; } - case THUNK_SELECTOR: + // We may end up here if a thunk update races with another update. + // In this case there is nothing to do as the other thread will have + // already pushed the updated thunk's free variables to the update + // remembered set. case BLACKHOLE: - // TODO: This is right, right? break; // The selector optimization performed by the nonmoving mark may have // overwritten a thunk which we are updating with an indirection. @@ -770,7 +810,7 @@ void markQueuePushClosure (MarkQueue *q, /* TODO: Do we really never want to specify the origin here? */ void markQueueAddRoot (MarkQueue* q, StgClosure** root) { - markQueuePushClosure(q, *root, NULL); + markQueuePushClosureGC(q, *root); } /* Push a closure to the mark queue without origin information */ @@ -881,6 +921,7 @@ static MarkQueueEnt markQueuePop (MarkQueue *q) static void init_mark_queue_ (MarkQueue *queue) { bdescr *bd = allocGroup(MARK_QUEUE_BLOCKS); + ASSERT(queue->blocks == NULL); queue->blocks = bd; queue->top = (MarkQueueBlock *) bd->start; queue->top->head = 0; @@ -898,18 +939,24 @@ void initMarkQueue (MarkQueue *queue) } /* Must hold sm_mutex. */ -void init_upd_rem_set (UpdRemSet *rset) +void nonmovingInitUpdRemSet (UpdRemSet *rset) { init_mark_queue_(&rset->queue); rset->queue.is_upd_rem_set = true; } -void reset_upd_rem_set (UpdRemSet *rset) +static void nonmovingResetUpdRemSetQueue (MarkQueue *rset) { // UpdRemSets always have one block for the mark queue. This assertion is to // update this code if we change that. - ASSERT(rset->queue.blocks->link == NULL); - rset->queue.top->head = 0; + ASSERT(rset->is_upd_rem_set); + ASSERT(rset->blocks->link == NULL); + rset->top->head = 0; +} + +void nonmovingResetUpdRemSet (UpdRemSet *rset) +{ + nonmovingResetUpdRemSetQueue(&rset->queue); } void freeMarkQueue (MarkQueue *queue) @@ -1257,8 +1304,11 @@ mark_closure (MarkQueue *queue, const StgClosure *p0, StgClosure **origin) goto done; case WHITEHOLE: - while (*(StgInfoTable* volatile*) &p->header.info == &stg_WHITEHOLE_info); - // busy_wait_nop(); // FIXME + while (*(StgInfoTable* volatile*) &p->header.info == &stg_WHITEHOLE_info) +#if defined(PARALLEL_GC) + busy_wait_nop() +#endif + ; goto try_again; default: @@ -1466,10 +1516,12 @@ mark_closure (MarkQueue *queue, const StgClosure *p0, StgClosure **origin) break; } + case WEAK: + ASSERT(is_nonmoving_weak((StgWeak*) p)); + // fallthrough gen_obj: case CONSTR: case CONSTR_NOCAF: - case WEAK: case PRIM: { for (StgWord i = 0; i < info->layout.payload.ptrs; i++) { @@ -1522,8 +1574,15 @@ mark_closure (MarkQueue *queue, const StgClosure *p0, StgClosure **origin) } case THUNK_SELECTOR: - nonmoving_eval_thunk_selector(queue, (StgSelector*)p, origin); + { + StgSelector *sel = (StgSelector *) p; + // We may be able to evaluate this selector which may render the + // selectee unreachable. However, we must mark the selectee regardless + // to satisfy the snapshot invariant. + PUSH_FIELD(sel, selectee); + nonmoving_eval_thunk_selector(queue, sel, origin); break; + } case AP_STACK: { StgAP_STACK *ap = (StgAP_STACK *)p; @@ -1673,15 +1732,23 @@ done: * b. the nursery has been fully evacuated into the non-moving generation. * c. the mark queue has been seeded with a set of roots. * + * If budget is not UNLIMITED_MARK_BUDGET, then we will mark no more than the + * indicated number of objects and deduct the work done from the budget. */ GNUC_ATTR_HOT void -nonmovingMark (MarkQueue *queue) +nonmovingMark (MarkBudget* budget, MarkQueue *queue) { traceConcMarkBegin(); debugTrace(DEBUG_nonmoving_gc, "Starting mark pass"); - unsigned int count = 0; + uint64_t count = 0; while (true) { count++; + if (*budget == 0) { + return; + } else if (*budget != UNLIMITED_MARK_BUDGET) { + *budget -= 1; + } + MarkQueueEnt ent = markQueuePop(queue); switch (nonmovingMarkQueueEntryType(&ent)) { @@ -1810,20 +1877,64 @@ static bool nonmovingIsNowAlive (StgClosure *p) bdescr *bd = Bdescr((P_)p); - // All non-static objects in the non-moving heap should be marked as - // BF_NONMOVING - ASSERT(bd->flags & BF_NONMOVING); + const uint16_t flags = bd->flags; + if (flags & BF_LARGE) { + if (flags & BF_PINNED && !(flags & BF_NONMOVING)) { + // In this case we have a pinned object living in a non-full + // accumulator block which was not promoted to the nonmoving + // generation. Assume that the object is alive. + // See #22014. + return true; + } - if (bd->flags & BF_LARGE) { + ASSERT(bd->flags & BF_NONMOVING); return (bd->flags & BF_NONMOVING_SWEEPING) == 0 // the large object wasn't in the snapshot and therefore wasn't marked || (bd->flags & BF_MARKED) != 0; // The object was marked } else { - return nonmovingClosureMarkedThisCycle((P_)p); + // All non-static objects in the non-moving heap should be marked as + // BF_NONMOVING. + ASSERT(bd->flags & BF_NONMOVING); + + struct NonmovingSegment *seg = nonmovingGetSegment((StgPtr) p); + StgClosure *snapshot_loc = + (StgClosure *) nonmovingSegmentGetBlock(seg, nonmovingSegmentInfo(seg)->next_free_snap); + if (p >= snapshot_loc && nonmovingGetClosureMark((StgPtr) p) == 0) { + /* + * In this case we are looking at a block that wasn't allocated + * at the time that the snapshot was taken. As we do not mark such + * blocks, we must assume that it is reachable. + */ + return true; + } else { + return nonmovingClosureMarkedThisCycle((P_)p); + } + } +} + +// Mark all Weak#s on nonmoving_old_weak_ptr_list. +void nonmovingMarkWeakPtrList (struct MarkQueue_ *queue) +{ + ASSERT(nonmoving_weak_ptr_list == NULL); + for (StgWeak *w = nonmoving_old_weak_ptr_list; w != NULL; w = w->link) { + mark_closure(queue, (StgClosure *) w, NULL); } } +// Determine whether a weak pointer object is on one of the nonmoving +// collector's weak pointer lists. Used for sanity checking. +static bool is_nonmoving_weak(StgWeak *weak) +{ + for (StgWeak *w = nonmoving_old_weak_ptr_list; w != NULL; w = w->link) { + if (w == weak) return true; + } + for (StgWeak *w = nonmoving_weak_ptr_list; w != NULL; w = w->link) { + if (w == weak) return true; + } + return false; +} + // Non-moving heap variant of `tidyWeakList` bool nonmovingTidyWeaks (struct MarkQueue_ *queue) { @@ -1832,6 +1943,9 @@ bool nonmovingTidyWeaks (struct MarkQueue_ *queue) StgWeak **last_w = &nonmoving_old_weak_ptr_list; StgWeak *next_w; for (StgWeak *w = nonmoving_old_weak_ptr_list; w != NULL; w = next_w) { + // This should have been marked by nonmovingMarkWeaks + ASSERT(nonmovingIsNowAlive((StgClosure *) w)); + if (w->header.info == &stg_DEAD_WEAK_info) { // finalizeWeak# was called on the weak next_w = w->link; @@ -1842,7 +1956,10 @@ bool nonmovingTidyWeaks (struct MarkQueue_ *queue) // Otherwise it's a live weak ASSERT(w->header.info == &stg_WEAK_info); - if (nonmovingIsNowAlive(w->key)) { + // See Note [Weak pointer processing and the non-moving GC] in + // MarkWeak.c + bool key_in_nonmoving = Bdescr((StgPtr) w->key)->flags & BF_NONMOVING; + if (!key_in_nonmoving || nonmovingIsNowAlive(w->key)) { nonmovingMarkLiveWeak(queue, w); did_work = true; @@ -1850,7 +1967,7 @@ bool nonmovingTidyWeaks (struct MarkQueue_ *queue) *last_w = w->link; next_w = w->link; - // and put it on the weak ptr list + // and put it on nonmoving_weak_ptr_list w->link = nonmoving_weak_ptr_list; nonmoving_weak_ptr_list = w; } else { @@ -1872,7 +1989,8 @@ void nonmovingMarkDeadWeak (struct MarkQueue_ *queue, StgWeak *w) void nonmovingMarkLiveWeak (struct MarkQueue_ *queue, StgWeak *w) { - ASSERT(nonmovingClosureMarkedThisCycle((P_)w)); + ASSERT(nonmovingIsNowAlive((StgClosure *) w)); + ASSERT(nonmovingIsNowAlive((StgClosure *) w->key)); markQueuePushClosure_(queue, w->value); markQueuePushClosure_(queue, w->finalizer); markQueuePushClosure_(queue, w->cfinalizers); @@ -1886,9 +2004,9 @@ void nonmovingMarkDeadWeaks (struct MarkQueue_ *queue, StgWeak **dead_weaks) { StgWeak *next_w; for (StgWeak *w = nonmoving_old_weak_ptr_list; w; w = next_w) { - ASSERT(!nonmovingClosureMarkedThisCycle((P_)(w->key))); + ASSERT(!nonmovingIsNowAlive(w->key)); nonmovingMarkDeadWeak(queue, w); - next_w = w ->link; + next_w = w->link; w->link = *dead_weaks; *dead_weaks = w; } ===================================== rts/sm/NonMovingMark.h ===================================== @@ -111,6 +111,11 @@ typedef struct { MarkQueue queue; } UpdRemSet; +// How much marking work we are allowed to perform +// See Note [Sync phase marking budget] in NonMoving.c +typedef int64_t MarkBudget; +#define UNLIMITED_MARK_BUDGET INT64_MIN + // Number of blocks to allocate for a mark queue #define MARK_QUEUE_BLOCKS 16 @@ -135,10 +140,9 @@ extern MarkQueue *current_mark_queue; extern bdescr *upd_rem_set_block_list; -void nonmovingMarkInitUpdRemSet(void); +void nonmovingMarkInit(void); -void init_upd_rem_set(UpdRemSet *rset); -void reset_upd_rem_set(UpdRemSet *rset); +void nonmovingInitUpdRemSet(UpdRemSet *rset); void updateRemembSetPushClosure(Capability *cap, StgClosure *p); void updateRemembSetPushThunk(Capability *cap, StgThunk *p); void updateRemembSetPushTSO(Capability *cap, StgTSO *tso); @@ -155,8 +159,13 @@ void markQueueAddRoot(MarkQueue* q, StgClosure** root); void initMarkQueue(MarkQueue *queue); void freeMarkQueue(MarkQueue *queue); -void nonmovingMark(struct MarkQueue_ *restrict queue); +void nonmovingMark(MarkBudget *budget, struct MarkQueue_ *restrict queue); +INLINE_HEADER void nonmovingMarkUnlimitedBudget(struct MarkQueue_ *restrict queue) { + MarkBudget budget = UNLIMITED_MARK_BUDGET; + nonmovingMark(&budget, queue); +} +void nonmovingMarkWeakPtrList(struct MarkQueue_ *queue); bool nonmovingTidyWeaks(struct MarkQueue_ *queue); void nonmovingTidyThreads(void); void nonmovingMarkDeadWeaks(struct MarkQueue_ *queue, StgWeak **dead_weak_ptr_list); @@ -164,7 +173,7 @@ void nonmovingResurrectThreads(struct MarkQueue_ *queue, StgTSO **resurrected_th bool nonmovingIsAlive(StgClosure *p); void nonmovingMarkDeadWeak(struct MarkQueue_ *queue, StgWeak *w); void nonmovingMarkLiveWeak(struct MarkQueue_ *queue, StgWeak *w); -void nonmovingAddUpdRemSetBlocks(struct MarkQueue_ *rset); +void nonmovingAddUpdRemSetBlocks(UpdRemSet *rset); void markQueuePush(MarkQueue *q, const MarkQueueEnt *ent); void markQueuePushClosureGC(MarkQueue *q, StgClosure *p); ===================================== rts/sm/Sanity.c ===================================== @@ -619,11 +619,12 @@ static void checkNonmovingSegments (struct NonmovingSegment *seg) void checkNonmovingHeap (const struct NonmovingHeap *heap) { for (unsigned int i=0; i < NONMOVING_ALLOCA_CNT; i++) { - const struct NonmovingAllocator *alloc = heap->allocators[i]; + const struct NonmovingAllocator *alloc = &heap->allocators[i]; checkNonmovingSegments(alloc->filled); checkNonmovingSegments(alloc->active); - for (unsigned int cap=0; cap < getNumCapabilities(); cap++) { - checkNonmovingSegments(alloc->current[cap]); + for (unsigned int cap_n=0; cap_n < getNumCapabilities(); cap_n++) { + Capability *cap = capabilities[cap_n]; + checkNonmovingSegments(cap->current_segments[i]); } } } @@ -1047,11 +1048,12 @@ findMemoryLeak (void) markBlocks(nonmoving_compact_objects); markBlocks(nonmoving_marked_compact_objects); for (i = 0; i < NONMOVING_ALLOCA_CNT; i++) { - struct NonmovingAllocator *alloc = nonmovingHeap.allocators[i]; + struct NonmovingAllocator *alloc = &nonmovingHeap.allocators[i]; markNonMovingSegments(alloc->filled); markNonMovingSegments(alloc->active); for (j = 0; j < getNumCapabilities(); j++) { - markNonMovingSegments(alloc->current[j]); + Capability *cap = capabilities[j]; + markNonMovingSegments(cap->current_segments[i]); } } markNonMovingSegments(nonmovingHeap.sweep_list); @@ -1156,23 +1158,18 @@ countNonMovingSegments(struct NonmovingSegment *segs) return ret; } -static W_ -countNonMovingAllocator(struct NonmovingAllocator *alloc) -{ - W_ ret = countNonMovingSegments(alloc->filled) - + countNonMovingSegments(alloc->active); - for (uint32_t i = 0; i < getNumCapabilities(); ++i) { - ret += countNonMovingSegments(alloc->current[i]); - } - return ret; -} - static W_ countNonMovingHeap(struct NonmovingHeap *heap) { W_ ret = 0; for (int alloc_idx = 0; alloc_idx < NONMOVING_ALLOCA_CNT; alloc_idx++) { - ret += countNonMovingAllocator(heap->allocators[alloc_idx]); + struct NonmovingAllocator *alloc = &heap->allocators[alloc_idx]; + ret += countNonMovingSegments(alloc->filled); + ret += countNonMovingSegments(alloc->active); + for (uint32_t c = 0; c < getNumCapabilities(); ++c) { + Capability *cap = capabilities[c]; + ret += countNonMovingSegments(cap->current_segments[alloc_idx]); + } } ret += countNonMovingSegments(heap->sweep_list); ret += countNonMovingSegments(heap->free); ===================================== rts/sm/Storage.c ===================================== @@ -214,17 +214,14 @@ initStorage (void) } oldest_gen->to = oldest_gen; - // Nonmoving heap uses oldest_gen so initialize it after initializing oldest_gen - nonmovingInit(); - #if defined(THREADED_RTS) // nonmovingAddCapabilities allocates segments, which requires taking the gc // sync lock, so initialize it before nonmovingAddCapabilities initSpinLock(&gc_alloc_block_sync); #endif - if (RtsFlags.GcFlags.useNonmoving) - nonmovingAddCapabilities(getNumCapabilities()); + // Nonmoving heap uses oldest_gen so initialize it after initializing oldest_gen + nonmovingInit(); /* The oldest generation has one step. */ if (RtsFlags.GcFlags.compact || RtsFlags.GcFlags.sweep) { @@ -320,11 +317,10 @@ void storageAddCapabilities (uint32_t from, uint32_t to) } } - // Initialize NonmovingAllocators and UpdRemSets + // Initialize non-moving collector if (RtsFlags.GcFlags.useNonmoving) { - nonmovingAddCapabilities(to); - for (i = 0; i < to; ++i) { - init_upd_rem_set(&capabilities[i]->upd_rem_set); + for (i = from; i < to; i++) { + nonmovingInitCapability(capabilities[i]); } } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cfb775f0235d34d3831d8e1cafb51293d7664cc2...bb7f24a50e0235bfb07d34d2de4043e6c25a3cf5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cfb775f0235d34d3831d8e1cafb51293d7664cc2...bb7f24a50e0235bfb07d34d2de4043e6c25a3cf5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 20:29:25 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 07 Feb 2023 15:29:25 -0500 Subject: [Git][ghc/ghc][wip/T22264-9.2] relnotes: Mention various non-moving GC fixes Message-ID: <63e2b4a5bd1dc_1108fe5265c182043b@gitlab.mail> Ben Gamari pushed to branch wip/T22264-9.2 at Glasgow Haskell Compiler / GHC Commits: b623eaf3 by Ben Gamari at 2023-02-07T15:29:09-05:00 relnotes: Mention various non-moving GC fixes - - - - - 1 changed file: - docs/users_guide/9.2.6-notes.rst Changes: ===================================== docs/users_guide/9.2.6-notes.rst ===================================== @@ -66,6 +66,23 @@ Runtime system - Truncate eventlog events with a large payload (:ghc-ticket:`20221`). +- A bug in the nonmoving garbage collector regarding the treatment of + zero-length ``SmallArray#``\ s has been fixed (:ghc-ticket:`22264`) + +- A number of bugs regarding the non-moving garbage collector's treatment of + ``Weak#`` pointers have been fixed (:ghc-ticket:`22327`) + +- A few race conditions between the non-moving collector and + ``setNumCapabilities`` which could result in undefined behavior have been + fixed (:ghc-ticket:`22926`, :ghc-ticket:`22927`) + +- The non-moving collector is now able to better schedule marking work during + the post-mark synchronization phase of collection, significantly reducing + pause times in some workloads (:ghc-ticket:`22929`). + +- Various bugs in the non-moving collector's implementation of the selector + optimisation have been fixed (:ghc-ticket:`22930`) + Build system and packaging -------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b623eaf3a3c9deb28984618088e3192ad30d6414 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b623eaf3a3c9deb28984618088e3192ad30d6414 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 21:31:40 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 07 Feb 2023 16:31:40 -0500 Subject: [Git][ghc/ghc][wip/rts-warnings] Update Flavour.hs Message-ID: <63e2c33c13114_1108fe5265c1825576@gitlab.mail> Ben Gamari pushed to branch wip/rts-warnings at Glasgow Haskell Compiler / GHC Commits: 984c88e5 by Ben Gamari at 2023-02-07T21:31:38+00:00 Update Flavour.hs - - - - - 1 changed file: - hadrian/src/Flavour.hs Changes: ===================================== hadrian/src/Flavour.hs ===================================== @@ -133,8 +133,9 @@ werror = ? package unix ? mconcat [arg "-Wwarn=unused-imports", arg "-Wwarn=unused-top-binds"] -- Darwin has marked sem_getvalue as deprecated. - , package unix - ? arg "-optc-Wno-error=deprecated-declarations" + , package unix ? arg "-optc-Wno-error=deprecated-declarations" + -- Darwin has marked vfork as deprecated. + , package process ? arg "-optc-Wno-error=deprecated-declarations" ] ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/984c88e500ce50003902a149eb801f454a1be5a9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/984c88e500ce50003902a149eb801f454a1be5a9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 22:15:15 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 07 Feb 2023 17:15:15 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T22924 Message-ID: <63e2cd73852a3_1108fe52648184006@gitlab.mail> Simon Peyton Jones pushed new branch wip/T22924 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22924 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 23:15:21 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 07 Feb 2023 18:15:21 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: JS: avoid head/tail and unpackFS Message-ID: <63e2db89f9d7_1108fe81af58a8186866@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 26e88493 by Sylvain Henry at 2023-02-07T18:15:08-05:00 JS: avoid head/tail and unpackFS - - - - - a933eab7 by Krzysztof Gogolewski at 2023-02-07T18:15:09-05:00 testsuite: Fix Python warnings (#22856) - - - - - 3 changed files: - compiler/GHC/StgToJS/Printer.hs - testsuite/driver/runtests.py - testsuite/driver/testlib.py Changes: ===================================== compiler/GHC/StgToJS/Printer.hs ===================================== @@ -108,19 +108,17 @@ ghcjsRenderJsV r (JHash m) where quoteIfRequired :: FastString -> Doc quoteIfRequired x - | isUnquotedKey x' = text x' - | otherwise = PP.squotes (text x') - where x' = unpackFS x - - isUnquotedKey :: String -> Bool - isUnquotedKey x | null x = False - | all isDigit x = True - | otherwise = validFirstIdent (head x) - && all validOtherIdent (tail x) + | isUnquotedKey x = ftext x + | otherwise = PP.squotes (ftext x) + isUnquotedKey :: FastString -> Bool + isUnquotedKey fs = case unpackFS fs of + [] -> False + s@(c:cs) -> all isDigit s || (validFirstIdent c && all validOtherIdent cs) validFirstIdent c = c == '_' || c == '$' || isAlpha c validOtherIdent c = isAlpha c || isDigit c + ghcjsRenderJsV r v = renderJsV defaultRenderJs r v prettyBlock :: RenderJs -> [JStat] -> Doc ===================================== testsuite/driver/runtests.py ===================================== @@ -601,6 +601,7 @@ else: if args.junit: junit(t).write(args.junit) + args.junit.close() if config.only_report_hadrian_deps: print("WARNING - skipping all tests and only reporting required hadrian dependencies:", config.hadrian_deps) ===================================== testsuite/driver/testlib.py ===================================== @@ -1347,7 +1347,7 @@ def do_test(name: TestName, # if found and instead have the testsuite decide on what to do # with the output. def override_options(pre_cmd): - if config.verbose >= 5 and bool(re.match('\$make', pre_cmd, re.I)): + if config.verbose >= 5 and bool(re.match(r'\$make', pre_cmd, re.I)): return pre_cmd.replace(' -s' , '') \ .replace('--silent', '') \ .replace('--quiet' , '') @@ -1989,7 +1989,7 @@ def split_file(in_fn: Path, delimiter: str, out1_fn: Path, out2_fn: Path): with out1_fn.open('w', encoding='utf8', newline='') as out1: with out2_fn.open('w', encoding='utf8', newline='') as out2: line = infile.readline() - while re.sub('^\s*','',line) != delimiter and line != '': + while re.sub(r'^\s*','',line) != delimiter and line != '': out1.write(line) line = infile.readline() @@ -2399,20 +2399,20 @@ def normalise_errmsg(s: str) -> str: # warning message to get clean output. if config.msys: s = re.sub('Failed to remove file (.*); error= (.*)$', '', s) - s = re.sub('DeleteFile "(.+)": permission denied \(Access is denied\.\)(.*)$', '', s) + s = re.sub(r'DeleteFile "(.+)": permission denied \(Access is denied\.\)(.*)$', '', s) # filter out unsupported GNU_PROPERTY_TYPE (5), which is emitted by LLVM10 # and not understood by older binutils (ar, ranlib, ...) - s = modify_lines(s, lambda l: re.sub('^(.+)warning: (.+): unsupported GNU_PROPERTY_TYPE \(5\) type: 0xc000000(.*)$', '', l)) + s = modify_lines(s, lambda l: re.sub(r'^(.+)warning: (.+): unsupported GNU_PROPERTY_TYPE \(5\) type: 0xc000000(.*)$', '', l)) - s = re.sub('ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) + s = re.sub(r'ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) s = re.sub('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version','',s) # ignore superfluous dylibs passed to the linker. s = re.sub('ld: warning: .*, ignoring unexpected dylib file\n','',s) # ignore LLVM Version mismatch garbage; this will just break tests. s = re.sub('You are using an unsupported version of LLVM!.*\n','',s) - s = re.sub('Currently only [\.0-9]+ is supported. System LLVM version: [\.0-9]+.*\n','',s) - s = re.sub('We will try though\.\.\..*\n','',s) + s = re.sub('Currently only [\\.0-9]+ is supported. System LLVM version: [\\.0-9]+.*\n','',s) + s = re.sub('We will try though\\.\\.\\..*\n','',s) # ignore warning about strip invalidating signatures s = re.sub('.*strip: changes being made to the file will invalidate the code signature in.*\n','',s) # clang may warn about unused argument when used as assembler @@ -2475,8 +2475,8 @@ def normalise_slashes_( s: str ) -> str: return s def normalise_exe_( s: str ) -> str: - s = re.sub('\.exe', '', s) - s = re.sub('\.jsexe', '', s) + s = re.sub(r'\.exe', '', s) + s = re.sub(r'\.jsexe', '', s) return s def normalise_output( s: str ) -> str: @@ -2494,14 +2494,14 @@ def normalise_output( s: str ) -> str: # ghci outputs are pretty unstable with -fexternal-dynamic-refs, which is # requires for -fPIC s = re.sub(' -fexternal-dynamic-refs\n','',s) - s = re.sub('ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) + s = re.sub(r'ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) s = re.sub('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version','',s) # ignore superfluous dylibs passed to the linker. s = re.sub('ld: warning: .*, ignoring unexpected dylib file\n','',s) # ignore LLVM Version mismatch garbage; this will just break tests. s = re.sub('You are using an unsupported version of LLVM!.*\n','',s) - s = re.sub('Currently only [\.0-9]+ is supported. System LLVM version: [\.0-9]+.*\n','',s) - s = re.sub('We will try though\.\.\..*\n','',s) + s = re.sub('Currently only [\\.0-9]+ is supported. System LLVM version: [\\.0-9]+.*\n','',s) + s = re.sub('We will try though\\.\\.\\..*\n','',s) # ignore warning about strip invalidating signatures s = re.sub('.*strip: changes being made to the file will invalidate the code signature in.*\n','',s) # clang may warn about unused argument when used as assembler View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6769662417abe3d39cefeca0b97c4601183b0ad0...a933eab77971b711a652f9e681c9927173dff686 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6769662417abe3d39cefeca0b97c4601183b0ad0...a933eab77971b711a652f9e681c9927173dff686 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 23:16:20 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Tue, 07 Feb 2023 18:16:20 -0500 Subject: [Git][ghc/ghc][wip/T21909] Fixes #21909 Message-ID: <63e2dbc46cfe9_1108fe52634187199c@gitlab.mail> Apoorv Ingle pushed to branch wip/T21909 at Glasgow Haskell Compiler / GHC Commits: bd4624de by Apoorv Ingle at 2023-02-07T17:15:39-06:00 Fixes #21909 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag in `CDictCan.cc_pend_sc`. Pending Givens get a fuel of 3 to start of with while Wanted constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints. Added tests T21909, T21909b - - - - - 7 changed files: - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - + testsuite/tests/typecheck/should_compile/T21909.hs - + testsuite/tests/typecheck/should_compile/T21909b.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -2338,6 +2338,10 @@ maybe_simplify_again n limit unif_happened wc@(WC { wc_simple = simples }) do { new_given <- makeSuperClasses pending_given ; new_wanted <- makeSuperClasses pending_wanted ; solveSimpleGivens new_given -- Add the new Givens to the inert set + ; traceTcS "maybe_simplify_again" (vcat [ text "pending_given" <+> ppr pending_given + , text "new_given" <+> ppr new_given + , text "pending_wanted" <+> ppr pending_wanted + , text "new_wanted" <+> ppr new_wanted ]) ; simplify_loop n limit (not (null pending_given)) $ wc { wc_simple = simples1 `unionBags` listToBag new_wanted } } } -- (not (null pending_given)): see Note [Superclass iteration] ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -153,9 +153,9 @@ canClassNC :: CtEvidence -> Class -> [Type] -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence canClassNC ev cls tys | isGiven ev -- See Note [Eagerly expand given superclasses] - = do { sc_cts <- mkStrictSuperClasses ev [] [] cls tys + = do { sc_cts <- mkStrictSuperClasses defaultFuelGivens ev [] [] cls tys ; emitWork sc_cts - ; canClass ev cls tys False } + ; canClass ev cls tys doNotExpand } | CtWanted { ctev_rewriters = rewriters } <- ev , Just ip_name <- isCallStackPred cls tys @@ -181,14 +181,16 @@ canClassNC ev cls tys (ctLocSpan loc) (ctEvExpr new_ev) ; solveCallStack ev ev_cs - ; canClass new_ev cls tys False -- No superclasses + ; canClass new_ev cls tys doNotExpand -- No superclasses } | otherwise - = canClass ev cls tys (has_scs cls) + = canClass ev cls tys fuel where - has_scs cls = not (null (classSCTheta cls)) + fuel | cls_has_scs = defaultFuelWanteds + | otherwise = doNotExpand + cls_has_scs = not (null (classSCTheta cls)) loc = ctEvLoc ev orig = ctLocOrigin loc pred = ctEvPred ev @@ -205,7 +207,7 @@ solveCallStack ev ev_cs = do canClass :: CtEvidence -> Class -> [Type] - -> Bool -- True <=> un-explored superclasses + -> ExpansionFuel -- n > 0 <=> un-explored superclasses -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence @@ -497,34 +499,35 @@ makeSuperClasses :: [Ct] -> TcS [Ct] -- least produce the immediate superclasses makeSuperClasses cts = concatMapM go cts where - go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys }) - = mkStrictSuperClasses ev [] [] cls tys + go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys, cc_pend_sc = fuel }) + = assertPpr (fuel > 0) (ppr cls) $ -- fuel needs to be more than 0 always + mkStrictSuperClasses (consumeFuel fuel) ev [] [] cls tys go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev })) = assertPpr (isClassPred pred) (ppr pred) $ -- The cts should all have -- class pred heads - mkStrictSuperClasses ev tvs theta cls tys + mkStrictSuperClasses defaultFuelQC ev tvs theta cls tys where (tvs, theta, cls, tys) = tcSplitDFunTy (ctEvPred ev) go ct = pprPanic "makeSuperClasses" (ppr ct) mkStrictSuperClasses - :: CtEvidence + :: ExpansionFuel -> CtEvidence -> [TyVar] -> ThetaType -- These two args are non-empty only when taking -- superclasses of a /quantified/ constraint -> Class -> [Type] -> TcS [Ct] -- Return constraints for the strict superclasses of -- ev :: forall as. theta => cls tys -mkStrictSuperClasses ev tvs theta cls tys - = mk_strict_superclasses (unitNameSet (className cls)) +mkStrictSuperClasses fuel ev tvs theta cls tys + = mk_strict_superclasses fuel (unitNameSet (className cls)) ev tvs theta cls tys -mk_strict_superclasses :: NameSet -> CtEvidence +mk_strict_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return the immediate superclasses of (cls tys); -- and expand their superclasses, provided none of them are in rec_clss -- nor are repeated -mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) +mk_strict_superclasses fuel rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) tvs theta cls tys = concatMapM do_one_given $ classSCSelIds cls @@ -542,7 +545,7 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) | otherwise = do { given_ev <- newGivenEvVar sc_loc $ mk_given_desc sel_id sc_pred - ; mk_superclasses rec_clss given_ev tvs theta sc_pred } + ; mk_superclasses fuel rec_clss given_ev tvs theta sc_pred } where sc_pred = classMethodInstTy sel_id tys @@ -603,7 +606,7 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) newly_blocked (InstSkol _ head_size) = isJust (this_size `ltPatersonSize` head_size) newly_blocked _ = False -mk_strict_superclasses rec_clss ev tvs theta cls tys +mk_strict_superclasses fuel rec_clss ev tvs theta cls tys | all noFreeVarsOfType tys = return [] -- Wanteds with no variables yield no superclass constraints. -- See Note [Improvement from Ground Wanteds] @@ -618,7 +621,7 @@ mk_strict_superclasses rec_clss ev tvs theta cls tys do_one sc_pred = do { traceTcS "mk_strict_superclasses Wanted" (ppr (mkClassPred cls tys) $$ ppr sc_pred) ; sc_ev <- newWantedNC loc (ctEvRewriters ev) sc_pred - ; mk_superclasses rec_clss sc_ev [] [] sc_pred } + ; mk_superclasses fuel rec_clss sc_ev [] [] sc_pred } {- Note [Improvement from Ground Wanteds] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -633,29 +636,29 @@ dependencies. See Note [Why adding superclasses can help] above. But no variables means no improvement; case closed. -} -mk_superclasses :: NameSet -> CtEvidence +mk_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> PredType -> TcS [Ct] -- Return this constraint, plus its superclasses, if any -mk_superclasses rec_clss ev tvs theta pred +mk_superclasses fuel rec_clss ev tvs theta pred | ClassPred cls tys <- classifyPredType pred - = mk_superclasses_of rec_clss ev tvs theta cls tys + = mk_superclasses_of fuel rec_clss ev tvs theta cls tys | otherwise -- Superclass is not a class predicate = return [mkNonCanonical ev] -mk_superclasses_of :: NameSet -> CtEvidence +mk_superclasses_of :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return this class constraint, -- and expand its superclasses -mk_superclasses_of rec_clss ev tvs theta cls tys +mk_superclasses_of fuel rec_clss ev tvs theta cls tys | loop_found = do { traceTcS "mk_superclasses_of: loop" (ppr cls <+> ppr tys) ; return [this_ct] } -- cc_pend_sc of this_ct = True | otherwise = do { traceTcS "mk_superclasses_of" (vcat [ ppr cls <+> ppr tys , ppr (isCTupleClass cls) , ppr rec_clss ]) - ; sc_cts <- mk_strict_superclasses rec_clss' ev tvs theta cls tys + ; sc_cts <- mk_strict_superclasses fuel rec_clss' ev tvs theta cls tys ; return (this_ct : sc_cts) } -- cc_pend_sc of this_ct = False where @@ -664,9 +667,12 @@ mk_superclasses_of rec_clss ev tvs theta cls tys -- Tuples never contribute to recursion, and can be nested rec_clss' = rec_clss `extendNameSet` cls_nm + this_cc_pend | loop_found = fuel + | otherwise = 0 + this_ct | null tvs, null theta = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys - , cc_pend_sc = loop_found } + , cc_pend_sc = this_cc_pend } -- NB: If there is a loop, we cut off, so we have not -- added the superclasses, hence cc_pend_sc = True | otherwise @@ -827,7 +833,7 @@ canForAllNC :: CtEvidence -> [TyVar] -> TcThetaType -> TcPredType canForAllNC ev tvs theta pred | isGiven ev -- See Note [Eagerly expand given superclasses] , Just (cls, tys) <- cls_pred_tys_maybe - = do { sc_cts <- mkStrictSuperClasses ev tvs theta cls tys + = do { sc_cts <- mkStrictSuperClasses defaultFuelGivens ev tvs theta cls tys ; emitWork sc_cts ; canForAll ev False } ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -513,10 +513,13 @@ getInertGivens ; return (filter isGivenCt all_cts) } getPendingGivenScs :: TcS [Ct] --- Find all inert Given dictionaries, or quantified constraints, --- whose cc_pend_sc flag is True --- and that belong to the current level --- Set their cc_pend_sc flag to False in the inert set, and return that Ct +-- Find all inert Given dictionaries, or quantified constraints, such that +-- 1. cc_pend_sc flag has fuel strictly > 0 +-- 2. belongs to the current level +-- For each such dictionary: +-- * Return it (with unmodified cc_pend_sc) in sc_pending +-- * Modify the dict in the inert set to have cc_pend_sc = doNotExpand +-- to record that we have expanded superclasses for this dict getPendingGivenScs = do { lvl <- getTcLevel ; updRetInertCans (get_sc_pending lvl) } @@ -530,23 +533,24 @@ get_sc_pending this_lvl ic@(IC { inert_dicts = dicts, inert_insts = insts }) sc_pending = sc_pend_insts ++ sc_pend_dicts sc_pend_dicts = foldDicts get_pending dicts [] - dicts' = foldr add dicts sc_pend_dicts + dicts' = foldr exhaustAndAdd dicts sc_pend_dicts (sc_pend_insts, insts') = mapAccumL get_pending_inst [] insts - get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc = True - -- but flipping the flag + get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc > 0 get_pending dict dicts - | Just dict' <- pendingScDict_maybe dict + | isPendingScDict dict , belongs_to_this_level (ctEvidence dict) - = dict' : dicts + = dict : dicts | otherwise = dicts - add :: Ct -> DictMap Ct -> DictMap Ct - add ct@(CDictCan { cc_class = cls, cc_tyargs = tys }) dicts - = addDict dicts cls tys ct - add ct _ = pprPanic "getPendingScDicts" (ppr ct) + exhaustAndAdd :: Ct -> DictMap Ct -> DictMap Ct + exhaustAndAdd ct@(CDictCan { cc_class = cls, cc_tyargs = tys }) dicts + -- exhaust the fuel for this constraint before adding it as + -- we don't want to expand these constraints again + = addDict dicts cls tys (ct {cc_pend_sc = doNotExpand}) + exhaustAndAdd ct _ = pprPanic "getPendingScDicts" (ppr ct) get_pending_inst :: [Ct] -> QCInst -> ([Ct], QCInst) get_pending_inst cts qci@(QCI { qci_ev = ev }) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -11,6 +11,8 @@ module GHC.Tc.Types.Constraint ( -- Canonical constraints Xi, Ct(..), Cts, + ExpansionFuel, doNotExpand, defaultFuelGivens, defaultFuelWanteds, + defaultFuelQC, consumeFuel, emptyCts, andCts, andManyCts, pprCts, singleCt, listToCts, ctsElts, consCts, snocCts, extendCtsList, isEmptyCts, @@ -191,6 +193,19 @@ type Xi = TcType type Cts = Bag Ct +-- | Says how many layers of superclasses can we expand. +-- see T21909 +type ExpansionFuel = Int + +doNotExpand, defaultFuelGivens, defaultFuelWanteds, defaultFuelQC :: ExpansionFuel +doNotExpand = 0 +defaultFuelQC = 1 +defaultFuelWanteds = 1 +defaultFuelGivens = 3 + +consumeFuel :: ExpansionFuel -> ExpansionFuel +consumeFuel fuel = fuel - 1 + data Ct -- Atomic canonical constraints = CDictCan { -- e.g. Num ty @@ -199,11 +214,10 @@ data Ct cc_class :: Class, cc_tyargs :: [Xi], -- cc_tyargs are rewritten w.r.t. inerts, so Xi - cc_pend_sc :: Bool + cc_pend_sc :: ExpansionFuel -- See Note [The superclass story] in GHC.Tc.Solver.Canonical - -- True <=> (a) cc_class has superclasses - -- (b) we have not (yet) added those - -- superclasses as Givens + -- n > 0 <=> (a) cc_class has superclasses + -- (b) we have not (yet) explored those superclasses } | CIrredCan { -- These stand for yet-unusable predicates @@ -673,8 +687,8 @@ instance Outputable Ct where CEqCan {} -> text "CEqCan" CNonCanonical {} -> text "CNonCanonical" CDictCan { cc_pend_sc = psc } - | psc -> text "CDictCan(psc)" - | otherwise -> text "CDictCan" + | psc > 0 -> text "CDictCan" <> parens (text "psc" <+> ppr psc) + | otherwise -> text "CDictCan" CIrredCan { cc_reason = reason } -> text "CIrredCan" <> ppr reason CQuantCan (QCI { qci_pend_sc = pend_sc }) | pend_sc -> text "CQuantCan(psc)" @@ -893,16 +907,17 @@ isUserTypeError pred = case getUserTypeErrorMsg pred of _ -> False isPendingScDict :: Ct -> Bool -isPendingScDict (CDictCan { cc_pend_sc = psc }) = psc --- Says whether this is a CDictCan with cc_pend_sc is True; +isPendingScDict (CDictCan { cc_pend_sc = psc }) = psc > 0 +-- Says whether this is a CDictCan with cc_pend_sc has positive fuel; -- i.e. pending un-expanded superclasses isPendingScDict _ = False pendingScDict_maybe :: Ct -> Maybe Ct --- Says whether this is a CDictCan with cc_pend_sc is True, +-- Says whether this is a CDictCan with cc_pend_sc has fuel left, -- AND if so flips the flag -pendingScDict_maybe ct@(CDictCan { cc_pend_sc = True }) - = Just (ct { cc_pend_sc = False }) +pendingScDict_maybe ct@(CDictCan { cc_pend_sc = n }) + | n > 0 = Just (ct { cc_pend_sc = doNotExpand }) + | otherwise = Nothing pendingScDict_maybe _ = Nothing pendingScInst_maybe :: QCInst -> Maybe QCInst @@ -932,7 +947,7 @@ getPendingWantedScs simples = mapAccumBagL get [] simples where get acc ct | Just ct' <- pendingScDict_maybe ct - = (ct':acc, ct') + = (ct:acc, ct') | otherwise = (acc, ct) ===================================== testsuite/tests/typecheck/should_compile/T21909.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +module T21909 where + +import Data.Kind + +class (Monad m, MyMonad (Inner m)) => MyMonad m where + type Inner m :: Type -> Type + foo :: m Int + +works :: MyMonad m => m String +works = show <$> ((+ 1) <$> foo) + +fails :: MyMonad m => m String +fails = show <$> fooPlusOne + where + fooPlusOne = (+ 1) <$> foo + +alsoFails :: MyMonad m => m String +alsoFails = + let fooPlusOne = (+ 1) <$> foo + in show <$> fooPlusOne ===================================== testsuite/tests/typecheck/should_compile/T21909b.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableSuperClasses, FunctionalDependencies, MultiParamTypeClasses, GADTs #-} + +module T21909b where + +import Data.Kind + +class C [a] => C a where + foo :: a -> Int + +should_work :: C a => a -> Int +should_work x = foolocal x + where + foolocal a = foo a ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -857,3 +857,5 @@ test('T22647', normal, compile, ['']) test('T19577', normal, compile, ['']) test('T22383', normal, compile, ['']) test('T21501', normal, compile, ['']) +test('T21909', normal, compile, ['']) +test('T21909b', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd4624de94c4d526e83fff095e4139dceb7f39a4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd4624de94c4d526e83fff095e4139dceb7f39a4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 23:49:48 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Tue, 07 Feb 2023 18:49:48 -0500 Subject: [Git][ghc/ghc][wip/T21909] 4 commits: Don't allow . in overloaded labels Message-ID: <63e2e39c3f0a9_1108fe71da71381879316@gitlab.mail> Apoorv Ingle pushed to branch wip/T21909 at Glasgow Haskell Compiler / GHC Commits: b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - a201cc18 by Apoorv Ingle at 2023-02-07T23:49:40+00:00 Fixes #21909 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag in `CDictCan.cc_pend_sc`. Pending Givens get a fuel of 3 to start of with while Wanted constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints. Added tests T21909, T21909b - - - - - 14 changed files: - compiler/GHC/Core/TyCon.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - docs/users_guide/9.6.1-notes.rst - libraries/base/GHC/Int.hs - libraries/base/GHC/Word.hs - testsuite/tests/overloadedrecflds/should_run/T11671_run.hs - testsuite/tests/printer/Test22771.hs - + testsuite/tests/typecheck/should_compile/T21909.hs - + testsuite/tests/typecheck/should_compile/T21909b.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -194,7 +194,7 @@ Note [Type synonym families] * Type synonym families, also known as "type functions", map directly onto the type functions in FC: - type family F a :: * + type family F a :: Type type instance F Int = Bool ..etc... @@ -210,11 +210,11 @@ Note [Type synonym families] type instance F (F Int) = ... -- BAD! * Translation of type family decl: - type family F a :: * + type family F a :: Type translates to a FamilyTyCon 'F', whose FamTyConFlav is OpenSynFamilyTyCon - type family G a :: * where + type family G a :: Type where G Int = Bool G Bool = Char G a = () @@ -229,7 +229,7 @@ Note [Data type families] See also Note [Wrappers for data instance tycons] in GHC.Types.Id.Make * Data type families are declared thus - data family T a :: * + data family T a :: Type data instance T Int = T1 | T2 Bool Here T is the "family TyCon". @@ -321,7 +321,7 @@ See also Note [Wrappers for data instance tycons] in GHC.Types.Id.Make should not think of a data family T as a *type function* at all, not even an injective one! We can't allow even injective type functions on the LHS of a type function: - type family injective G a :: * + type family injective G a :: Type type instance F (G Int) = Bool is no good, even if G is injective, because consider type instance G Int = Bool @@ -572,21 +572,21 @@ Since they are user-callable we must get their type-argument visibility information right; and that info is in the TyConBinders. Here is an example: - data App a b = MkApp (a b) -- App :: forall {k}. (k->*) -> k -> * + data App a b = MkApp (a b) -- App :: forall {k}. (k->Type) -> k -> Type The TyCon has - tyConTyBinders = [ Named (Bndr (k :: *) Inferred), Anon (k->*), Anon k ] + tyConTyBinders = [ Named (Bndr (k :: Type) Inferred), Anon (k->Type), Anon k ] The TyConBinders for App line up with App's kind, given above. But the DataCon MkApp has the type - MkApp :: forall {k} (a:k->*) (b:k). a b -> App k a b + MkApp :: forall {k} (a:k->Type) (b:k). a b -> App k a b That is, its ForAllTyBinders should be - dataConUnivTyVarBinders = [ Bndr (k:*) Inferred - , Bndr (a:k->*) Specified + dataConUnivTyVarBinders = [ Bndr (k:Type) Inferred + , Bndr (a:k->Type) Specified , Bndr (b:k) Specified ] So tyConTyVarBinders converts TyCon's TyConBinders into TyVarBinders: @@ -620,8 +620,8 @@ They fit together like so: type App a (b :: k) = a b - tyConBinders = [ Bndr (k::*) (NamedTCB Inferred) - , Bndr (a:k->*) AnonTCB + tyConBinders = [ Bndr (k::Type) (NamedTCB Inferred) + , Bndr (a:k->Type) AnonTCB , Bndr (b:k) AnonTCB ] Note that there are three binders here, including the @@ -636,13 +636,13 @@ They fit together like so: that TyVar may scope over some other part of the TyCon's definition. Eg type T a = a -> a we have - tyConBinders = [ Bndr (a:*) AnonTCB ] + tyConBinders = [ Bndr (a:Type) AnonTCB ] synTcRhs = a -> a So the 'a' scopes over the synTcRhs * From the tyConBinders and tyConResKind we can get the tyConKind E.g for our App example: - App :: forall k. (k->*) -> k -> * + App :: forall k. (k->Type) -> k -> Type We get a 'forall' in the kind for each NamedTCB, and an arrow for each AnonTCB @@ -725,15 +725,15 @@ instance Binary TyConBndrVis where -- things such as: -- -- 1) Data declarations: @data Foo = ...@ creates the @Foo@ type constructor of --- kind @*@ +-- kind @Type@ -- -- 2) Type synonyms: @type Foo = ...@ creates the @Foo@ type constructor -- -- 3) Newtypes: @newtype Foo a = MkFoo ...@ creates the @Foo@ type constructor --- of kind @* -> *@ +-- of kind @Type -> Type@ -- -- 4) Class declarations: @class Foo where@ creates the @Foo@ type constructor --- of kind @*@ +-- of kind @Constraint@ -- -- This data type also encodes a number of primitive, built in type constructors -- such as those for function and tuple types. @@ -1252,16 +1252,16 @@ data FamTyConFlav -- -- These are introduced by either a top level declaration: -- - -- > data family T a :: * + -- > data family T a :: Type -- -- Or an associated data type declaration, within a class declaration: -- -- > class C a b where - -- > data T b :: * + -- > data T b :: Type DataFamilyTyCon TyConRepName - -- | An open type synonym family e.g. @type family F x y :: * -> *@ + -- | An open type synonym family e.g. @type family F x y :: Type -> Type@ | OpenSynFamilyTyCon -- | A closed type synonym family e.g. ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -163,7 +163,6 @@ $small = [$ascsmall $unismall \_] $uniidchar = \x07 -- Trick Alex into handling Unicode. See Note [Unicode in Alex]. $idchar = [$small $large $digit $uniidchar \'] -$labelchar = [$small $large $digit $uniidchar \' \.] $unigraphic = \x06 -- Trick Alex into handling Unicode. See Note [Unicode in Alex]. $graphic = [$small $large $symbol $digit $idchar $special $unigraphic \"\'] @@ -455,7 +454,7 @@ $unigraphic / { isSmartQuote } { smart_quote_error } } <0> { - "#" $labelchar+ / { ifExtension OverloadedLabelsBit } { skip_one_varid_src ITlabelvarid } + "#" $idchar+ / { ifExtension OverloadedLabelsBit } { skip_one_varid_src ITlabelvarid } "#" \" / { ifExtension OverloadedLabelsBit } { lex_quoted_label } } ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -2338,6 +2338,10 @@ maybe_simplify_again n limit unif_happened wc@(WC { wc_simple = simples }) do { new_given <- makeSuperClasses pending_given ; new_wanted <- makeSuperClasses pending_wanted ; solveSimpleGivens new_given -- Add the new Givens to the inert set + ; traceTcS "maybe_simplify_again" (vcat [ text "pending_given" <+> ppr pending_given + , text "new_given" <+> ppr new_given + , text "pending_wanted" <+> ppr pending_wanted + , text "new_wanted" <+> ppr new_wanted ]) ; simplify_loop n limit (not (null pending_given)) $ wc { wc_simple = simples1 `unionBags` listToBag new_wanted } } } -- (not (null pending_given)): see Note [Superclass iteration] ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -153,9 +153,9 @@ canClassNC :: CtEvidence -> Class -> [Type] -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence canClassNC ev cls tys | isGiven ev -- See Note [Eagerly expand given superclasses] - = do { sc_cts <- mkStrictSuperClasses ev [] [] cls tys + = do { sc_cts <- mkStrictSuperClasses defaultFuelGivens ev [] [] cls tys ; emitWork sc_cts - ; canClass ev cls tys False } + ; canClass ev cls tys doNotExpand } | CtWanted { ctev_rewriters = rewriters } <- ev , Just ip_name <- isCallStackPred cls tys @@ -181,14 +181,16 @@ canClassNC ev cls tys (ctLocSpan loc) (ctEvExpr new_ev) ; solveCallStack ev ev_cs - ; canClass new_ev cls tys False -- No superclasses + ; canClass new_ev cls tys doNotExpand -- No superclasses } | otherwise - = canClass ev cls tys (has_scs cls) + = canClass ev cls tys fuel where - has_scs cls = not (null (classSCTheta cls)) + fuel | cls_has_scs = defaultFuelWanteds + | otherwise = doNotExpand + cls_has_scs = not (null (classSCTheta cls)) loc = ctEvLoc ev orig = ctLocOrigin loc pred = ctEvPred ev @@ -205,7 +207,7 @@ solveCallStack ev ev_cs = do canClass :: CtEvidence -> Class -> [Type] - -> Bool -- True <=> un-explored superclasses + -> ExpansionFuel -- n > 0 <=> un-explored superclasses -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence @@ -497,34 +499,35 @@ makeSuperClasses :: [Ct] -> TcS [Ct] -- least produce the immediate superclasses makeSuperClasses cts = concatMapM go cts where - go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys }) - = mkStrictSuperClasses ev [] [] cls tys + go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys, cc_pend_sc = fuel }) + = assertPpr (fuel > 0) (ppr cls) $ -- fuel needs to be more than 0 always + mkStrictSuperClasses (consumeFuel fuel) ev [] [] cls tys go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev })) = assertPpr (isClassPred pred) (ppr pred) $ -- The cts should all have -- class pred heads - mkStrictSuperClasses ev tvs theta cls tys + mkStrictSuperClasses defaultFuelQC ev tvs theta cls tys where (tvs, theta, cls, tys) = tcSplitDFunTy (ctEvPred ev) go ct = pprPanic "makeSuperClasses" (ppr ct) mkStrictSuperClasses - :: CtEvidence + :: ExpansionFuel -> CtEvidence -> [TyVar] -> ThetaType -- These two args are non-empty only when taking -- superclasses of a /quantified/ constraint -> Class -> [Type] -> TcS [Ct] -- Return constraints for the strict superclasses of -- ev :: forall as. theta => cls tys -mkStrictSuperClasses ev tvs theta cls tys - = mk_strict_superclasses (unitNameSet (className cls)) +mkStrictSuperClasses fuel ev tvs theta cls tys + = mk_strict_superclasses fuel (unitNameSet (className cls)) ev tvs theta cls tys -mk_strict_superclasses :: NameSet -> CtEvidence +mk_strict_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return the immediate superclasses of (cls tys); -- and expand their superclasses, provided none of them are in rec_clss -- nor are repeated -mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) +mk_strict_superclasses fuel rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) tvs theta cls tys = concatMapM do_one_given $ classSCSelIds cls @@ -542,7 +545,7 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) | otherwise = do { given_ev <- newGivenEvVar sc_loc $ mk_given_desc sel_id sc_pred - ; mk_superclasses rec_clss given_ev tvs theta sc_pred } + ; mk_superclasses fuel rec_clss given_ev tvs theta sc_pred } where sc_pred = classMethodInstTy sel_id tys @@ -603,7 +606,7 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) newly_blocked (InstSkol _ head_size) = isJust (this_size `ltPatersonSize` head_size) newly_blocked _ = False -mk_strict_superclasses rec_clss ev tvs theta cls tys +mk_strict_superclasses fuel rec_clss ev tvs theta cls tys | all noFreeVarsOfType tys = return [] -- Wanteds with no variables yield no superclass constraints. -- See Note [Improvement from Ground Wanteds] @@ -618,7 +621,7 @@ mk_strict_superclasses rec_clss ev tvs theta cls tys do_one sc_pred = do { traceTcS "mk_strict_superclasses Wanted" (ppr (mkClassPred cls tys) $$ ppr sc_pred) ; sc_ev <- newWantedNC loc (ctEvRewriters ev) sc_pred - ; mk_superclasses rec_clss sc_ev [] [] sc_pred } + ; mk_superclasses fuel rec_clss sc_ev [] [] sc_pred } {- Note [Improvement from Ground Wanteds] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -633,29 +636,29 @@ dependencies. See Note [Why adding superclasses can help] above. But no variables means no improvement; case closed. -} -mk_superclasses :: NameSet -> CtEvidence +mk_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> PredType -> TcS [Ct] -- Return this constraint, plus its superclasses, if any -mk_superclasses rec_clss ev tvs theta pred +mk_superclasses fuel rec_clss ev tvs theta pred | ClassPred cls tys <- classifyPredType pred - = mk_superclasses_of rec_clss ev tvs theta cls tys + = mk_superclasses_of fuel rec_clss ev tvs theta cls tys | otherwise -- Superclass is not a class predicate = return [mkNonCanonical ev] -mk_superclasses_of :: NameSet -> CtEvidence +mk_superclasses_of :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return this class constraint, -- and expand its superclasses -mk_superclasses_of rec_clss ev tvs theta cls tys +mk_superclasses_of fuel rec_clss ev tvs theta cls tys | loop_found = do { traceTcS "mk_superclasses_of: loop" (ppr cls <+> ppr tys) ; return [this_ct] } -- cc_pend_sc of this_ct = True | otherwise = do { traceTcS "mk_superclasses_of" (vcat [ ppr cls <+> ppr tys , ppr (isCTupleClass cls) , ppr rec_clss ]) - ; sc_cts <- mk_strict_superclasses rec_clss' ev tvs theta cls tys + ; sc_cts <- mk_strict_superclasses fuel rec_clss' ev tvs theta cls tys ; return (this_ct : sc_cts) } -- cc_pend_sc of this_ct = False where @@ -664,9 +667,12 @@ mk_superclasses_of rec_clss ev tvs theta cls tys -- Tuples never contribute to recursion, and can be nested rec_clss' = rec_clss `extendNameSet` cls_nm + this_cc_pend | loop_found = fuel + | otherwise = 0 + this_ct | null tvs, null theta = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys - , cc_pend_sc = loop_found } + , cc_pend_sc = this_cc_pend } -- NB: If there is a loop, we cut off, so we have not -- added the superclasses, hence cc_pend_sc = True | otherwise @@ -827,7 +833,7 @@ canForAllNC :: CtEvidence -> [TyVar] -> TcThetaType -> TcPredType canForAllNC ev tvs theta pred | isGiven ev -- See Note [Eagerly expand given superclasses] , Just (cls, tys) <- cls_pred_tys_maybe - = do { sc_cts <- mkStrictSuperClasses ev tvs theta cls tys + = do { sc_cts <- mkStrictSuperClasses defaultFuelGivens ev tvs theta cls tys ; emitWork sc_cts ; canForAll ev False } ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -513,10 +513,13 @@ getInertGivens ; return (filter isGivenCt all_cts) } getPendingGivenScs :: TcS [Ct] --- Find all inert Given dictionaries, or quantified constraints, --- whose cc_pend_sc flag is True --- and that belong to the current level --- Set their cc_pend_sc flag to False in the inert set, and return that Ct +-- Find all inert Given dictionaries, or quantified constraints, such that +-- 1. cc_pend_sc flag has fuel strictly > 0 +-- 2. belongs to the current level +-- For each such dictionary: +-- * Return it (with unmodified cc_pend_sc) in sc_pending +-- * Modify the dict in the inert set to have cc_pend_sc = doNotExpand +-- to record that we have expanded superclasses for this dict getPendingGivenScs = do { lvl <- getTcLevel ; updRetInertCans (get_sc_pending lvl) } @@ -530,23 +533,24 @@ get_sc_pending this_lvl ic@(IC { inert_dicts = dicts, inert_insts = insts }) sc_pending = sc_pend_insts ++ sc_pend_dicts sc_pend_dicts = foldDicts get_pending dicts [] - dicts' = foldr add dicts sc_pend_dicts + dicts' = foldr exhaustAndAdd dicts sc_pend_dicts (sc_pend_insts, insts') = mapAccumL get_pending_inst [] insts - get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc = True - -- but flipping the flag + get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc > 0 get_pending dict dicts - | Just dict' <- pendingScDict_maybe dict + | isPendingScDict dict , belongs_to_this_level (ctEvidence dict) - = dict' : dicts + = dict : dicts | otherwise = dicts - add :: Ct -> DictMap Ct -> DictMap Ct - add ct@(CDictCan { cc_class = cls, cc_tyargs = tys }) dicts - = addDict dicts cls tys ct - add ct _ = pprPanic "getPendingScDicts" (ppr ct) + exhaustAndAdd :: Ct -> DictMap Ct -> DictMap Ct + exhaustAndAdd ct@(CDictCan { cc_class = cls, cc_tyargs = tys }) dicts + -- exhaust the fuel for this constraint before adding it as + -- we don't want to expand these constraints again + = addDict dicts cls tys (ct {cc_pend_sc = doNotExpand}) + exhaustAndAdd ct _ = pprPanic "getPendingScDicts" (ppr ct) get_pending_inst :: [Ct] -> QCInst -> ([Ct], QCInst) get_pending_inst cts qci@(QCI { qci_ev = ev }) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -11,6 +11,8 @@ module GHC.Tc.Types.Constraint ( -- Canonical constraints Xi, Ct(..), Cts, + ExpansionFuel, doNotExpand, defaultFuelGivens, defaultFuelWanteds, + defaultFuelQC, consumeFuel, emptyCts, andCts, andManyCts, pprCts, singleCt, listToCts, ctsElts, consCts, snocCts, extendCtsList, isEmptyCts, @@ -191,6 +193,19 @@ type Xi = TcType type Cts = Bag Ct +-- | Says how many layers of superclasses can we expand. +-- see T21909 +type ExpansionFuel = Int + +doNotExpand, defaultFuelGivens, defaultFuelWanteds, defaultFuelQC :: ExpansionFuel +doNotExpand = 0 +defaultFuelQC = 1 +defaultFuelWanteds = 1 +defaultFuelGivens = 3 + +consumeFuel :: ExpansionFuel -> ExpansionFuel +consumeFuel fuel = fuel - 1 + data Ct -- Atomic canonical constraints = CDictCan { -- e.g. Num ty @@ -199,11 +214,10 @@ data Ct cc_class :: Class, cc_tyargs :: [Xi], -- cc_tyargs are rewritten w.r.t. inerts, so Xi - cc_pend_sc :: Bool + cc_pend_sc :: ExpansionFuel -- See Note [The superclass story] in GHC.Tc.Solver.Canonical - -- True <=> (a) cc_class has superclasses - -- (b) we have not (yet) added those - -- superclasses as Givens + -- n > 0 <=> (a) cc_class has superclasses + -- (b) we have not (yet) explored those superclasses } | CIrredCan { -- These stand for yet-unusable predicates @@ -673,8 +687,8 @@ instance Outputable Ct where CEqCan {} -> text "CEqCan" CNonCanonical {} -> text "CNonCanonical" CDictCan { cc_pend_sc = psc } - | psc -> text "CDictCan(psc)" - | otherwise -> text "CDictCan" + | psc > 0 -> text "CDictCan" <> parens (text "psc" <+> ppr psc) + | otherwise -> text "CDictCan" CIrredCan { cc_reason = reason } -> text "CIrredCan" <> ppr reason CQuantCan (QCI { qci_pend_sc = pend_sc }) | pend_sc -> text "CQuantCan(psc)" @@ -893,16 +907,17 @@ isUserTypeError pred = case getUserTypeErrorMsg pred of _ -> False isPendingScDict :: Ct -> Bool -isPendingScDict (CDictCan { cc_pend_sc = psc }) = psc --- Says whether this is a CDictCan with cc_pend_sc is True; +isPendingScDict (CDictCan { cc_pend_sc = psc }) = psc > 0 +-- Says whether this is a CDictCan with cc_pend_sc has positive fuel; -- i.e. pending un-expanded superclasses isPendingScDict _ = False pendingScDict_maybe :: Ct -> Maybe Ct --- Says whether this is a CDictCan with cc_pend_sc is True, +-- Says whether this is a CDictCan with cc_pend_sc has fuel left, -- AND if so flips the flag -pendingScDict_maybe ct@(CDictCan { cc_pend_sc = True }) - = Just (ct { cc_pend_sc = False }) +pendingScDict_maybe ct@(CDictCan { cc_pend_sc = n }) + | n > 0 = Just (ct { cc_pend_sc = doNotExpand }) + | otherwise = Nothing pendingScDict_maybe _ = Nothing pendingScInst_maybe :: QCInst -> Maybe QCInst @@ -932,7 +947,7 @@ getPendingWantedScs simples = mapAccumBagL get [] simples where get acc ct | Just ct' <- pendingScDict_maybe ct - = (ct':acc, ct') + = (ct:acc, ct') | otherwise = (acc, ct) ===================================== docs/users_guide/9.6.1-notes.rst ===================================== @@ -84,7 +84,7 @@ Language This extends the variety syntax for constructing labels under :extension:`OverloadedLabels`. Examples of newly allowed syntax: - Leading capital letters: `#Foo` equivalant to `getLabel @"Foo"` - - Numeric characters: `#3.14` equivalent to `getLabel @"3.14"` + - Numeric characters: `#1728` equivalent to `getLabel @"1728"` - Arbitrary strings: `#"Hello, World!"` equivalent to `getLabel @"Hello, World!"` Compiler ===================================== libraries/base/GHC/Int.hs ===================================== @@ -69,8 +69,8 @@ instance Eq Int8 where (/=) = neInt8 eqInt8, neInt8 :: Int8 -> Int8 -> Bool -eqInt8 (I8# x) (I8# y) = isTrue# (x `eqInt8#` y) -neInt8 (I8# x) (I8# y) = isTrue# (x `neInt8#` y) +eqInt8 (I8# x) (I8# y) = isTrue# ((int8ToInt# x) ==# (int8ToInt# y)) +neInt8 (I8# x) (I8# y) = isTrue# ((int8ToInt# x) /=# (int8ToInt# y)) {-# INLINE [1] eqInt8 #-} {-# INLINE [1] neInt8 #-} @@ -280,8 +280,8 @@ instance Eq Int16 where (/=) = neInt16 eqInt16, neInt16 :: Int16 -> Int16 -> Bool -eqInt16 (I16# x) (I16# y) = isTrue# (x `eqInt16#` y) -neInt16 (I16# x) (I16# y) = isTrue# (x `neInt16#` y) +eqInt16 (I16# x) (I16# y) = isTrue# ((int16ToInt# x) ==# (int16ToInt# y)) +neInt16 (I16# x) (I16# y) = isTrue# ((int16ToInt# x) /=# (int16ToInt# y)) {-# INLINE [1] eqInt16 #-} {-# INLINE [1] neInt16 #-} @@ -488,8 +488,8 @@ instance Eq Int32 where (/=) = neInt32 eqInt32, neInt32 :: Int32 -> Int32 -> Bool -eqInt32 (I32# x) (I32# y) = isTrue# (x `eqInt32#` y) -neInt32 (I32# x) (I32# y) = isTrue# (x `neInt32#` y) +eqInt32 (I32# x) (I32# y) = isTrue# ((int32ToInt# x) ==# (int32ToInt# y)) +neInt32 (I32# x) (I32# y) = isTrue# ((int32ToInt# x) /=# (int32ToInt# y)) {-# INLINE [1] eqInt32 #-} {-# INLINE [1] neInt32 #-} ===================================== libraries/base/GHC/Word.hs ===================================== @@ -78,8 +78,8 @@ instance Eq Word8 where (/=) = neWord8 eqWord8, neWord8 :: Word8 -> Word8 -> Bool -eqWord8 (W8# x) (W8# y) = isTrue# (x `eqWord8#` y) -neWord8 (W8# x) (W8# y) = isTrue# (x `neWord8#` y) +eqWord8 (W8# x) (W8# y) = isTrue# ((word8ToWord# x) `eqWord#` (word8ToWord# y)) +neWord8 (W8# x) (W8# y) = isTrue# ((word8ToWord# x) `neWord#` (word8ToWord# y)) {-# INLINE [1] eqWord8 #-} {-# INLINE [1] neWord8 #-} @@ -268,8 +268,8 @@ instance Eq Word16 where (/=) = neWord16 eqWord16, neWord16 :: Word16 -> Word16 -> Bool -eqWord16 (W16# x) (W16# y) = isTrue# (x `eqWord16#` y) -neWord16 (W16# x) (W16# y) = isTrue# (x `neWord16#` y) +eqWord16 (W16# x) (W16# y) = isTrue# ((word16ToWord# x) `eqWord#` (word16ToWord# y)) +neWord16 (W16# x) (W16# y) = isTrue# ((word16ToWord# x) `neWord#` (word16ToWord# y)) {-# INLINE [1] eqWord16 #-} {-# INLINE [1] neWord16 #-} @@ -500,8 +500,8 @@ instance Eq Word32 where (/=) = neWord32 eqWord32, neWord32 :: Word32 -> Word32 -> Bool -eqWord32 (W32# x) (W32# y) = isTrue# (x `eqWord32#` y) -neWord32 (W32# x) (W32# y) = isTrue# (x `neWord32#` y) +eqWord32 (W32# x) (W32# y) = isTrue# ((word32ToWord# x) `eqWord#` (word32ToWord# y)) +neWord32 (W32# x) (W32# y) = isTrue# ((word32ToWord# x) `neWord#` (word32ToWord# y)) {-# INLINE [1] eqWord32 #-} {-# INLINE [1] neWord32 #-} ===================================== testsuite/tests/overloadedrecflds/should_run/T11671_run.hs ===================================== @@ -12,8 +12,9 @@ import GHC.Prim (Addr#) instance KnownSymbol symbol => IsLabel symbol String where fromLabel = symbolVal (Proxy :: Proxy symbol) -(#) :: String -> Int -> String +(#), (#.) :: String -> Int -> String (#) _ i = show i +_ #. i = show i f :: Addr# -> Int -> String f _ i = show i @@ -26,13 +27,13 @@ main = traverse_ putStrLn , #type , #Foo , #3 - , #199.4 + , #"199.4" , #17a23b , #f'a' , #'a' , #' , #''notTHSplice - , #... + , #"..." , #привет , #こんにちは , #"3" ===================================== testsuite/tests/printer/Test22771.hs ===================================== @@ -14,8 +14,9 @@ import GHC.Prim (Addr#) instance KnownSymbol symbol => IsLabel symbol String where fromLabel = symbolVal (Proxy :: Proxy symbol) -(#) :: String -> Int -> String +(#), (#.) :: String -> Int -> String (#) _ i = show i +_ #. i = show i f :: Addr# -> Int -> String f _ i = show i @@ -28,13 +29,13 @@ main = traverse_ putStrLn , #type , #Foo , #3 - , #199.4 + , #"199.4" , #17a23b , #f'a' , #'a' , #' , #''notTHSplice - , #... + , #"..." , #привет , #こんにちは , #"3" ===================================== testsuite/tests/typecheck/should_compile/T21909.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +module T21909 where + +import Data.Kind + +class (Monad m, MyMonad (Inner m)) => MyMonad m where + type Inner m :: Type -> Type + foo :: m Int + +works :: MyMonad m => m String +works = show <$> ((+ 1) <$> foo) + +fails :: MyMonad m => m String +fails = show <$> fooPlusOne + where + fooPlusOne = (+ 1) <$> foo + +alsoFails :: MyMonad m => m String +alsoFails = + let fooPlusOne = (+ 1) <$> foo + in show <$> fooPlusOne ===================================== testsuite/tests/typecheck/should_compile/T21909b.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableSuperClasses, FunctionalDependencies, MultiParamTypeClasses, GADTs #-} + +module T21909b where + +import Data.Kind + +class C [a] => C a where + foo :: a -> Int + +should_work :: C a => a -> Int +should_work x = foolocal x + where + foolocal a = foo a ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -857,3 +857,5 @@ test('T22647', normal, compile, ['']) test('T19577', normal, compile, ['']) test('T22383', normal, compile, ['']) test('T21501', normal, compile, ['']) +test('T21909', normal, compile, ['']) +test('T21909b', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bd4624de94c4d526e83fff095e4139dceb7f39a4...a201cc18a0c7d7ffb5154fcac573cfc3ca6dd458 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bd4624de94c4d526e83fff095e4139dceb7f39a4...a201cc18a0c7d7ffb5154fcac573cfc3ca6dd458 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 7 23:50:22 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Tue, 07 Feb 2023 18:50:22 -0500 Subject: [Git][ghc/ghc][wip/T21909] Change `qci_pend_sc` from `Bool` to `ExpansionFuel` Message-ID: <63e2e3beea222_1108fe81af58a818798e@gitlab.mail> Apoorv Ingle pushed to branch wip/T21909 at Glasgow Haskell Compiler / GHC Commits: 2d07c9b9 by Apoorv Ingle at 2023-02-07T17:50:04-06:00 Change `qci_pend_sc` from `Bool` to `ExpansionFuel` - - - - - 3 changed files: - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs Changes: ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -494,18 +494,18 @@ makeSuperClasses :: [Ct] -> TcS [Ct] -- class C [a] => D a -- makeSuperClasses (C x) will return (D x, C [x]) -- --- NB: the incoming constraints have had their cc_pend_sc flag already --- flipped to False, by isPendingScDict, so we are /obliged/ to at --- least produce the immediate superclasses +-- NB: the incoming constraints will be expanded only if the fuel is striclty > 0 +-- expansion will consume a unit of fuel makeSuperClasses cts = concatMapM go cts where go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys, cc_pend_sc = fuel }) = assertPpr (fuel > 0) (ppr cls) $ -- fuel needs to be more than 0 always mkStrictSuperClasses (consumeFuel fuel) ev [] [] cls tys - go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev })) + go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev, qci_pend_sc = fuel })) = assertPpr (isClassPred pred) (ppr pred) $ -- The cts should all have -- class pred heads - mkStrictSuperClasses defaultFuelQC ev tvs theta cls tys + assertPpr (fuel > 0) (ppr cls) $ -- fuel needs to be more than 0 always + mkStrictSuperClasses (consumeFuel fuel) ev tvs theta cls tys where (tvs, theta, cls, tys) = tcSplitDFunTy (ctEvPred ev) go ct = pprPanic "makeSuperClasses" (ppr ct) @@ -653,14 +653,14 @@ mk_superclasses_of :: ExpansionFuel -> NameSet -> CtEvidence -- and expand its superclasses mk_superclasses_of fuel rec_clss ev tvs theta cls tys | loop_found = do { traceTcS "mk_superclasses_of: loop" (ppr cls <+> ppr tys) - ; return [this_ct] } -- cc_pend_sc of this_ct = True + ; return [this_ct] } -- cc_pend_sc of this_ct = fuel | otherwise = do { traceTcS "mk_superclasses_of" (vcat [ ppr cls <+> ppr tys , ppr (isCTupleClass cls) , ppr rec_clss ]) ; sc_cts <- mk_strict_superclasses fuel rec_clss' ev tvs theta cls tys ; return (this_ct : sc_cts) } - -- cc_pend_sc of this_ct = False + -- cc_pend_sc of this_ct = doNotExpand where cls_nm = className cls loop_found = not (isCTupleClass cls) && cls_nm `elemNameSet` rec_clss @@ -678,7 +678,7 @@ mk_superclasses_of fuel rec_clss ev tvs theta cls tys | otherwise = CQuantCan (QCI { qci_tvs = tvs, qci_pred = mkClassPred cls tys , qci_ev = ev - , qci_pend_sc = loop_found }) + , qci_pend_sc = this_cc_pend }) {- Note [Equality superclasses in quantified constraints] @@ -835,17 +835,19 @@ canForAllNC ev tvs theta pred , Just (cls, tys) <- cls_pred_tys_maybe = do { sc_cts <- mkStrictSuperClasses defaultFuelGivens ev tvs theta cls tys ; emitWork sc_cts - ; canForAll ev False } + ; canForAll ev doNotExpand } | otherwise - = canForAll ev (isJust cls_pred_tys_maybe) + = canForAll ev fuel where + fuel | isJust cls_pred_tys_maybe = defaultFuelQC + | otherwise = doNotExpand cls_pred_tys_maybe = getClassPredTys_maybe pred -canForAll :: CtEvidence -> Bool -> TcS (StopOrContinue Ct) +canForAll :: CtEvidence -> ExpansionFuel -> TcS (StopOrContinue Ct) -- We have a constraint (forall as. blah => C tys) -canForAll ev pend_sc +canForAll ev fuel = do { -- First rewrite it to apply the current substitution let pred = ctEvPred ev ; (redn, rewriters) <- rewrite ev pred @@ -855,14 +857,14 @@ canForAll ev pend_sc -- (It takes a lot less code to rewrite before decomposing.) ; case classifyPredType (ctEvPred new_ev) of ForAllPred tvs theta pred - -> solveForAll new_ev tvs theta pred pend_sc + -> solveForAll new_ev tvs theta pred fuel _ -> pprPanic "canForAll" (ppr new_ev) } } -solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> Bool +solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> ExpansionFuel -> TcS (StopOrContinue Ct) solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_loc = loc }) - tvs theta pred _pend_sc + tvs theta pred _fuel = -- See Note [Solving a Wanted forall-constraint] setLclEnv (ctLocEnv loc) $ -- This setLclEnv is important: the emitImplicationTcS uses that @@ -908,12 +910,12 @@ solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_lo _ -> pSizeType pred -- See Note [Solving a Given forall-constraint] -solveForAll ev@(CtGiven {}) tvs _theta pred pend_sc +solveForAll ev@(CtGiven {}) tvs _theta pred fuel = do { addInertForAll qci ; stopWith ev "Given forall-constraint" } where qci = QCI { qci_ev = ev, qci_tvs = tvs - , qci_pred = pred, qci_pend_sc = pend_sc } + , qci_pred = pred, qci_pend_sc = fuel } {- Note [Solving a Wanted forall-constraint] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -548,7 +548,7 @@ get_sc_pending this_lvl ic@(IC { inert_dicts = dicts, inert_insts = insts }) exhaustAndAdd :: Ct -> DictMap Ct -> DictMap Ct exhaustAndAdd ct@(CDictCan { cc_class = cls, cc_tyargs = tys }) dicts -- exhaust the fuel for this constraint before adding it as - -- we don't want to expand these constraints again + -- we don't want to expand these constraints again = addDict dicts cls tys (ct {cc_pend_sc = doNotExpand}) exhaustAndAdd ct _ = pprPanic "getPendingScDicts" (ppr ct) @@ -556,7 +556,10 @@ get_sc_pending this_lvl ic@(IC { inert_dicts = dicts, inert_insts = insts }) get_pending_inst cts qci@(QCI { qci_ev = ev }) | Just qci' <- pendingScInst_maybe qci , belongs_to_this_level ev - = (CQuantCan qci' : cts, qci') + = (CQuantCan qci : cts, qci') + -- qci' have their fuel exhausted + -- we don't want to expand these constraints again + -- qci is expanded | otherwise = (cts, qci) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -287,8 +287,9 @@ data QCInst -- A much simplified version of ClsInst -- Always Given , qci_tvs :: [TcTyVar] -- The tvs , qci_pred :: TcPredType -- The ty - , qci_pend_sc :: Bool -- Same as cc_pend_sc flag in CDictCan - -- Invariant: True => qci_pred is a ClassPred + , qci_pend_sc :: ExpansionFuel -- Same as cc_pend_sc flag in CDictCan + -- Invariants: qci_pend_sc > 0 => qci_pred is a ClassPred + -- the superclasses are unexplored } instance Outputable QCInst where @@ -690,8 +691,8 @@ instance Outputable Ct where | psc > 0 -> text "CDictCan" <> parens (text "psc" <+> ppr psc) | otherwise -> text "CDictCan" CIrredCan { cc_reason = reason } -> text "CIrredCan" <> ppr reason - CQuantCan (QCI { qci_pend_sc = pend_sc }) - | pend_sc -> text "CQuantCan(psc)" + CQuantCan (QCI { qci_pend_sc = psc }) + | psc > 0 -> text "CQuantCan" <> parens (text "psc" <+> ppr psc) | otherwise -> text "CQuantCan" ----------------------------------- @@ -922,9 +923,9 @@ pendingScDict_maybe _ = Nothing pendingScInst_maybe :: QCInst -> Maybe QCInst -- Same as isPendingScDict, but for QCInsts -pendingScInst_maybe qci@(QCI { qci_pend_sc = True }) - = Just (qci { qci_pend_sc = False }) -pendingScInst_maybe _ = Nothing +pendingScInst_maybe qci@(QCI { qci_pend_sc = n }) + | n > 0 = Just (qci { qci_pend_sc = doNotExpand }) + | otherwise = Nothing superClassesMightHelp :: WantedConstraints -> Bool -- ^ True if taking superclasses of givens, or of wanteds (to perhaps @@ -943,6 +944,7 @@ superClassesMightHelp (WC { wc_simple = simples, wc_impl = implics }) is_ip _ = False getPendingWantedScs :: Cts -> ([Ct], Cts) +-- [Ct] has original fuel while Cts has fuel exhausted getPendingWantedScs simples = mapAccumBagL get [] simples where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2d07c9b94c542671e0a19c86d0d3a65e64cbeaf4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2d07c9b94c542671e0a19c86d0d3a65e64cbeaf4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 00:09:59 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 07 Feb 2023 19:09:59 -0500 Subject: [Git][ghc/ghc][wip/T22264] 5 commits: gitlab-ci: Add job bootstrapping with nonmoving GC Message-ID: <63e2e857d28c0_1108fe71da713818807eb@gitlab.mail> Ben Gamari pushed to branch wip/T22264 at Glasgow Haskell Compiler / GHC Commits: d6928933 by Ben Gamari at 2023-02-07T19:09:33-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 81a59ab5 by Ben Gamari at 2023-02-07T19:09:36-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 32a37096 by Ben Gamari at 2023-02-07T19:09:36-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - 0a4dae19 by Ben Gamari at 2023-02-07T19:09:36-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - a8f0b6ac by Ben Gamari at 2023-02-07T19:09:36-05:00 nonmoving: Fix unregisterised build - - - - - 15 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - libraries/ghc-heap/tests/all.T - rts/include/rts/storage/MBlock.h - rts/sm/GC.c - rts/sm/GCUtils.c - rts/sm/GCUtils.h - rts/sm/HeapAlloc.h - rts/sm/NonMoving.c - rts/sm/NonMoving.h - rts/sm/NonMovingMark.c - rts/sm/Storage.h - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/perf/space_leaks/all.T - testsuite/tests/rts/all.T Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -147,6 +147,7 @@ data BuildConfig , tablesNextToCode :: Bool , threadSanitiser :: Bool , noSplitSections :: Bool + , validateNonmovingGc :: Bool } -- Extra arguments to pass to ./configure due to the BuildConfig @@ -165,11 +166,14 @@ mkJobFlavour BuildConfig{..} = Flavour buildFlavour opts [Dwarf | withDwarf] ++ [FullyStatic | fullyStatic] ++ [ThreadSanitiser | threadSanitiser] ++ - [NoSplitSections | noSplitSections, buildFlavour == Release ] + [NoSplitSections | noSplitSections, buildFlavour == Release ] ++ + [BootNonmovingGc | validateNonmovingGc ] data Flavour = Flavour BaseFlavour [FlavourTrans] -data FlavourTrans = Llvm | Dwarf | FullyStatic | ThreadSanitiser | NoSplitSections +data FlavourTrans + = Llvm | Dwarf | FullyStatic | ThreadSanitiser | NoSplitSections + | BootNonmovingGc data BaseFlavour = Release | Validate | SlowValidate deriving Eq @@ -194,6 +198,7 @@ vanilla = BuildConfig , tablesNextToCode = True , threadSanitiser = False , noSplitSections = False + , validateNonmovingGc = False } splitSectionsBroken :: BuildConfig -> BuildConfig @@ -317,6 +322,7 @@ flavourString (Flavour base trans) = baseString base ++ concatMap (("+" ++) . fl flavourString FullyStatic = "fully_static" flavourString ThreadSanitiser = "thread_sanitizer" flavourString NoSplitSections = "no_split_sections" + flavourString BootNonmovingGc = "boot_nonmoving_gc" -- The path to the docker image (just for linux builders) dockerImage :: Arch -> Opsys -> Maybe String @@ -544,6 +550,7 @@ data Rule = FastCI -- ^ Run this job when the fast-ci label is set | Nightly -- ^ Only run this job in the nightly pipeline | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. + | NonmovingGc -- ^ Only run this job when the "non-moving GC" label is set. | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) @@ -564,6 +571,8 @@ ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" ruleString Off FreeBSDLabel = true +ruleString On NonmovingGc = "$CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/" +ruleString Off NonmovingGc = true ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" @@ -660,7 +669,7 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } jobDependencies = [] jobVariables = mconcat [ opsysVariables arch opsys - ,"TEST_ENV" =: testEnv arch opsys buildConfig + , "TEST_ENV" =: testEnv arch opsys buildConfig , "BIN_DIST_NAME" =: binDistName arch opsys buildConfig , "BUILD_FLAVOUR" =: flavourString jobFlavour , "BIGNUM_BACKEND" =: bignumString (bignumBackend buildConfig) @@ -674,6 +683,9 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } Emulator s -> "CROSS_EMULATOR" =: s NoEmulatorNeeded -> mempty , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else mempty + , if validateNonmovingGc buildConfig + then "RUNTEST_ARGS" =: "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity" + else mempty ] jobArtifacts = Artifacts @@ -889,10 +901,12 @@ job_groups = , make_wasm_jobs wasm_build_config , disableValidate $ make_wasm_jobs wasm_build_config { bignumBackend = Native } , disableValidate $ make_wasm_jobs wasm_build_config { unregisterised = True } + , addValidateRule NonmovingGc (standardBuildsWithConfig Amd64 (Linux Debian11) vanilla {validateNonmovingGc = True}) ] where hackage_doc_job = rename (<> "-hackage") . modifyJobs (addVariable "HADRIAN_ARGS" "--haddock-base-url") + tsan_jobs = modifyJobs ( addVariable "TSAN_OPTIONS" "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" ===================================== .gitlab/jobs.yaml ===================================== @@ -35,7 +35,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -97,7 +97,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -155,7 +155,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -213,7 +213,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -276,7 +276,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -335,7 +335,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -394,7 +394,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -453,7 +453,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -518,7 +518,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -579,7 +579,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -640,7 +640,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -701,7 +701,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -764,7 +764,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -825,7 +825,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -888,7 +888,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -948,7 +948,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1007,7 +1007,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1066,7 +1066,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1126,7 +1126,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1185,7 +1185,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1244,7 +1244,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1303,7 +1303,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1362,7 +1362,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1423,7 +1423,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1484,7 +1484,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1546,7 +1546,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1570,6 +1570,66 @@ "XZ_OPT": "-9" } }, + "nightly-x86_64-linux-deb11-validate+boot_nonmoving_gc": { + "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-deb11-validate+boot_nonmoving_gc.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$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-deb11-validate+boot_nonmoving_gc", + "BUILD_FLAVOUR": "validate+boot_nonmoving_gc", + "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", + "TEST_ENV": "x86_64-linux-deb11-validate+boot_nonmoving_gc", + "XZ_OPT": "-9" + } + }, "nightly-x86_64-linux-deb9-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -1605,7 +1665,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1664,7 +1724,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1725,7 +1785,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1787,7 +1847,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1848,7 +1908,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1908,7 +1968,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1967,7 +2027,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2022,7 +2082,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2081,7 +2141,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2144,7 +2204,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2208,7 +2268,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2268,7 +2328,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2328,7 +2388,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2394,7 +2454,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2458,7 +2518,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2522,7 +2582,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2583,7 +2643,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2643,7 +2703,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2703,7 +2763,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2728,6 +2788,67 @@ "XZ_OPT": "-9" } }, + "release-x86_64-linux-deb11-release+boot_nonmoving_gc": { + "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-deb11-release+boot_nonmoving_gc.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$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-deb11-release+boot_nonmoving_gc", + "BUILD_FLAVOUR": "release+boot_nonmoving_gc", + "CONFIGURE_ARGS": "", + "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", + "TEST_ENV": "x86_64-linux-deb11-release+boot_nonmoving_gc", + "XZ_OPT": "-9" + } + }, "release-x86_64-linux-deb9-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -2763,7 +2884,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2823,7 +2944,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2885,7 +3006,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2947,7 +3068,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3010,7 +3131,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3071,7 +3192,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3131,7 +3252,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3187,7 +3308,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3247,7 +3368,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3311,7 +3432,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3375,7 +3496,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3435,7 +3556,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3495,7 +3616,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3557,7 +3678,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3616,7 +3737,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3674,7 +3795,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3733,7 +3854,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3791,7 +3912,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3849,7 +3970,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3908,7 +4029,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3968,7 +4089,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4028,7 +4149,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4054,6 +4175,65 @@ "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate" } }, + "x86_64-linux-deb11-validate+boot_nonmoving_gc": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "2 weeks", + "paths": [ + "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$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\") && ($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/) && (\"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-deb11-validate+boot_nonmoving_gc", + "BUILD_FLAVOUR": "validate+boot_nonmoving_gc", + "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", + "TEST_ENV": "x86_64-linux-deb11-validate+boot_nonmoving_gc" + } + }, "x86_64-linux-fedora33-release": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -4089,7 +4269,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4145,7 +4325,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], ===================================== libraries/ghc-heap/tests/all.T ===================================== @@ -5,7 +5,8 @@ test('heap_all', # These ways produce slightly different heap representations. # Currently we don't test them. omit_ways(['ghci', 'hpc', - 'nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc']), + 'nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc', + 'nonmoving_thr_sanity']), # The debug RTS initializes some fields with 0xaa and so # this test spuriously fails. when(compiler_debugged(), skip) ===================================== rts/include/rts/storage/MBlock.h ===================================== @@ -25,8 +25,3 @@ extern void freeAllMBlocks(void); extern void *getFirstMBlock(void **state); extern void *getNextMBlock(void **state, void *mblock); - -#if defined(THREADED_RTS) -// needed for HEAP_ALLOCED below -extern SpinLock gc_alloc_block_sync; -#endif ===================================== rts/sm/GC.c ===================================== @@ -376,7 +376,8 @@ GarbageCollect (uint32_t collect_gen, static_flag == STATIC_FLAG_A ? STATIC_FLAG_B : STATIC_FLAG_A; } - if (major_gc) { + /* N.B. We currently don't unload code with the non-moving collector. */ + if (major_gc && !RtsFlags.GcFlags.useNonmoving) { unload_mark_needed = prepareUnloadCheck(); } else { unload_mark_needed = false; ===================================== rts/sm/GCUtils.c ===================================== @@ -36,18 +36,18 @@ bdescr* allocGroup_sync(uint32_t n) { bdescr *bd; uint32_t node = capNoToNumaNode(gct->thread_index); - ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync); + ACQUIRE_ALLOC_BLOCK_SPIN_LOCK(); bd = allocGroupOnNode(node,n); - RELEASE_SPIN_LOCK(&gc_alloc_block_sync); + RELEASE_ALLOC_BLOCK_SPIN_LOCK(); return bd; } bdescr* allocGroupOnNode_sync(uint32_t node, uint32_t n) { bdescr *bd; - ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync); + ACQUIRE_ALLOC_BLOCK_SPIN_LOCK(); bd = allocGroupOnNode(node,n); - RELEASE_SPIN_LOCK(&gc_alloc_block_sync); + RELEASE_ALLOC_BLOCK_SPIN_LOCK(); return bd; } @@ -57,7 +57,7 @@ allocBlocks_sync(uint32_t n, bdescr **hd) bdescr *bd; uint32_t i; uint32_t node = capNoToNumaNode(gct->thread_index); - ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync); + ACQUIRE_ALLOC_BLOCK_SPIN_LOCK(); bd = allocLargeChunkOnNode(node,1,n); // NB. allocLargeChunk, rather than allocGroup(n), to allocate in a // fragmentation-friendly way. @@ -70,7 +70,7 @@ allocBlocks_sync(uint32_t n, bdescr **hd) bd[n-1].link = NULL; // We have to hold the lock until we've finished fiddling with the metadata, // otherwise the block allocator can get confused. - RELEASE_SPIN_LOCK(&gc_alloc_block_sync); + RELEASE_ALLOC_BLOCK_SPIN_LOCK(); *hd = bd; return n; } @@ -78,17 +78,17 @@ allocBlocks_sync(uint32_t n, bdescr **hd) void freeChain_sync(bdescr *bd) { - ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync); + ACQUIRE_ALLOC_BLOCK_SPIN_LOCK(); freeChain(bd); - RELEASE_SPIN_LOCK(&gc_alloc_block_sync); + RELEASE_ALLOC_BLOCK_SPIN_LOCK(); } void freeGroup_sync(bdescr *bd) { - ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync); + ACQUIRE_ALLOC_BLOCK_SPIN_LOCK(); freeGroup(bd); - RELEASE_SPIN_LOCK(&gc_alloc_block_sync); + RELEASE_ALLOC_BLOCK_SPIN_LOCK(); } /* ----------------------------------------------------------------------------- ===================================== rts/sm/GCUtils.h ===================================== @@ -17,6 +17,9 @@ #include "BeginPrivate.h" +#define ACQUIRE_ALLOC_BLOCK_SPIN_LOCK() ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync) +#define RELEASE_ALLOC_BLOCK_SPIN_LOCK() RELEASE_SPIN_LOCK(&gc_alloc_block_sync) + bdescr* allocGroup_sync(uint32_t n); bdescr* allocGroupOnNode_sync(uint32_t node, uint32_t n); ===================================== rts/sm/HeapAlloc.h ===================================== @@ -210,9 +210,9 @@ StgBool HEAP_ALLOCED_GC(const void *p) } else { // putting the rest out of line turned out to be a slight // performance improvement: - ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync); + ACQUIRE_ALLOC_BLOCK_SPIN_LOCK(); b = HEAP_ALLOCED_miss(mblock,p); - RELEASE_SPIN_LOCK(&gc_alloc_block_sync); + RELEASE_ALLOC_BLOCK_SPIN_LOCK(); return b; } } ===================================== rts/sm/NonMoving.c ===================================== @@ -636,12 +636,12 @@ static struct NonmovingSegment *nonmovingAllocSegment(uint32_t node) if (ret == NULL) { // Take gc spinlock: another thread may be scavenging a moving // generation and call `todo_block_full` - ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync); + ACQUIRE_ALLOC_BLOCK_SPIN_LOCK(); bdescr *bd = allocAlignedGroupOnNode(node, NONMOVING_SEGMENT_BLOCKS); // See Note [Live data accounting in nonmoving collector]. oldest_gen->n_blocks += bd->blocks; oldest_gen->n_words += BLOCK_SIZE_W * bd->blocks; - RELEASE_SPIN_LOCK(&gc_alloc_block_sync); + RELEASE_ALLOC_BLOCK_SPIN_LOCK(); for (StgWord32 i = 0; i < bd->blocks; ++i) { initBdescr(&bd[i], oldest_gen, oldest_gen); ===================================== rts/sm/NonMoving.h ===================================== @@ -341,10 +341,14 @@ INLINE_HEADER bool nonmovingClosureBeingSwept(StgClosure *p) } } +// N.B. RtsFlags is defined as a pointer in STG code consequently this code +// doesn't typecheck. +#if !IN_STG_CODE INLINE_HEADER bool isNonmovingClosure(StgClosure *p) { return RtsFlags.GcFlags.useNonmoving && (!HEAP_ALLOCED_GC(p) || Bdescr((P_)p)->flags & BF_NONMOVING); } +#endif #if defined(DEBUG) ===================================== rts/sm/NonMovingMark.c ===================================== @@ -493,13 +493,13 @@ markQueuePushClosureGC (MarkQueue *q, StgClosure *p) if (q->top->head == MARK_QUEUE_BLOCK_ENTRIES) { // Yes, this block is full. // allocate a fresh block. - ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync); + ACQUIRE_ALLOC_BLOCK_SPIN_LOCK(); bdescr *bd = allocGroup(MARK_QUEUE_BLOCKS); bd->link = q->blocks; q->blocks = bd; q->top = (MarkQueueBlock *) bd->start; q->top->head = 0; - RELEASE_SPIN_LOCK(&gc_alloc_block_sync); + RELEASE_ALLOC_BLOCK_SPIN_LOCK(); } MarkQueueEnt ent = { ===================================== rts/sm/Storage.h ===================================== @@ -43,6 +43,15 @@ extern Mutex sm_mutex; #define ASSERT_SM_LOCK() #endif +#if defined(THREADED_RTS) +// needed for HEAP_ALLOCED below +extern SpinLock gc_alloc_block_sync; +#endif + +#define ACQUIRE_ALLOC_BLOCK_SPIN_LOCK() ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync) +#define RELEASE_ALLOC_BLOCK_SPIN_LOCK() RELEASE_SPIN_LOCK(&gc_alloc_block_sync) + + /* ----------------------------------------------------------------------------- The write barrier for MVARs and TVARs -------------------------------------------------------------------------- */ ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -203,7 +203,7 @@ test('T15696_3', normal, compile_and_run, ['-O']) test('T15892', [ ignore_stdout, # -G1 is unsupported by the nonmoving GC - omit_ways(['nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc']), + omit_ways(['nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc', 'nonmoving_thr_sanity']), # we want to do lots of major GC to make the bug more likely to # happen, so -G1 -A32k: extra_run_opts('+RTS -G1 -A32k -RTS') ], ===================================== testsuite/tests/perf/space_leaks/all.T ===================================== @@ -6,7 +6,8 @@ test('space_leak_001', # 5% possible deviation. [ collect_stats('bytes allocated',5), collect_runtime_residency(15), - omit_ways(['profasm','profthreaded','threaded1','threaded2','nonmoving_thr']) + omit_ways(['profasm','profthreaded','threaded1','threaded2', + 'nonmoving_thr', 'nonmoving_thr_sanity']) ], compile_and_run, ['']) @@ -17,7 +18,7 @@ test('T4334', collect_runtime_residency(2), # prof ways don't work well with +RTS -V0, nonmoving way residency is # highly variable. - omit_ways(['profasm','profthreaded','nonmoving_thr']) + omit_ways(['profasm','profthreaded','nonmoving_thr', 'nonmoving_thr_sanity']) ], compile_and_run, ['']) ===================================== testsuite/tests/rts/all.T ===================================== @@ -110,7 +110,7 @@ test('T2047', [ignore_stdout, extra_run_opts('+RTS -c -RTS'), # Non-moving collector doesn't support -c - omit_ways(['nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc'])], + omit_ways(['nonmoving', 'nonmoving_thr', 'nonmoving_thr_sanity', 'nonmoving_thr_ghc'])], compile_and_run, ['-package containers']) # Blackhole-detection test. @@ -261,7 +261,8 @@ test('T6006', [ omit_ways(prof_ways + ['ghci']), test('T7037', js_broken(22374), makefile_test, ['T7037']) test('T7087', exit_code(1), compile_and_run, ['']) -test('T7160', [ omit_ways(['nonmoving_thr', 'nonmoving_thr_ghc']) +test('T7160', [ # finalization order is too nondeterministic in the concurrent GC + omit_ways(['nonmoving_thr', 'nonmoving_thr_ghc', 'nonmoving_thr_sanity']) , js_broken(22261) ], compile_and_run, ['']) @@ -450,6 +451,9 @@ test('T14900', test('InternalCounters', [ js_skip # JS backend doesn't support internal counters + # The ways which build against the debug RTS are built with PROF_SPIN and + # therefore differ in output + , omit_ways(['nonmoving_thr_sanity', 'threaded2_sanity', 'sanity']) ], makefile_test, ['InternalCounters']) test('alloccounter1', js_broken(22261), compile_and_run, [ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/df51737ca3b07794d9844fa95689305a75cbad74...a8f0b6ac647011d519835e4089251071a1d72492 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/df51737ca3b07794d9844fa95689305a75cbad74...a8f0b6ac647011d519835e4089251071a1d72492 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 00:10:44 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Tue, 07 Feb 2023 19:10:44 -0500 Subject: [Git][ghc/ghc][wip/9.2.6-backports] Allow metric changes for 9.2.6 as baseline is from a release pipeline Message-ID: <63e2e884d956a_1108fe5263418811d3@gitlab.mail> Zubin pushed to branch wip/9.2.6-backports at Glasgow Haskell Compiler / GHC Commits: 86738a94 by Zubin Duggal at 2023-02-08T05:40:31+05:30 Allow metric changes for 9.2.6 as baseline is from a release pipeline Metric Decrease: haddock.base haddock.Cabal haddock.compiler Metric Increase: ManyAlternatives ManyConstructors T10421 T10858 T12227 T12425 T12707 T13035 T13253 T13719 T15164 T16577 T18304 T18698a T18698b T3294 T5321FD T5642 T9203 T9233 T9630 T9872a T9872b T9872c T9872d T14697 - - - - - 0 changed files: Changes: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86738a94bff9fd2755072b075bba6586a28528cc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86738a94bff9fd2755072b075bba6586a28528cc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 00:12:44 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Tue, 07 Feb 2023 19:12:44 -0500 Subject: [Git][ghc/ghc][wip/9.2.6-backports] Allow metric changes for 9.2.6 as baseline is from a release pipeline Message-ID: <63e2e8fca507_1108fe5263418837d9@gitlab.mail> Zubin pushed to branch wip/9.2.6-backports at Glasgow Haskell Compiler / GHC Commits: 67ec973c by Zubin Duggal at 2023-02-08T05:42:32+05:30 Allow metric changes for 9.2.6 as baseline is from a release pipeline Metric Decrease: haddock.base haddock.Cabal haddock.compiler Metric Increase: ManyAlternatives ManyConstructors T10421 T10858 T12227 T12425 T12707 T13035 T13253 T13719 T15164 T16577 T18304 T18698a T18698b T3294 T5321FD T5642 T9203 T9233 T9630 T9872a T9872b T9872c T9872d T14697 T12545 - - - - - 0 changed files: Changes: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/67ec973ce40d8a66d48c0f5f40458380957b6e6f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/67ec973ce40d8a66d48c0f5f40458380957b6e6f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 00:22:30 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 07 Feb 2023 19:22:30 -0500 Subject: [Git][ghc/ghc][wip/T22264-9.2] 19 commits: nonmoving: Refactor update remembered set initialization Message-ID: <63e2eb463e6b6_1108fe5ddd5ad81884630@gitlab.mail> Ben Gamari pushed to branch wip/T22264-9.2 at Glasgow Haskell Compiler / GHC Commits: 04efedba by Ben Gamari at 2023-02-07T19:22:09-05:00 nonmoving: Refactor update remembered set initialization This avoids a lock inversion between the storage manager mutex and the stable pointer table mutex by not dropping the SM_MUTEX in nonmovingCollect. This requires quite a bit of rejiggering but it does seem like a better strategy. (cherry picked from commit 543cae0084a72ca767a443d857f9e65a5a79f71d) - - - - - d1f7532f by Ben Gamari at 2023-02-07T19:22:09-05:00 nonmoving: Fix style (cherry picked from commit b642ef1dc4cbe19c3479b2c014e7d1f7959f8e4a) - - - - - 84a09d55 by Ben Gamari at 2023-02-07T19:22:09-05:00 Evac: Squash data race in eval_selector_chain (cherry picked from commit dd784b3b01f076fa7f5715150c53ad4c183ae79d) - - - - - c2f23c0d by Ben Gamari at 2023-02-07T19:22:09-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Likely fixes the cause of #22264. (cherry picked from commit f8988a9c53ae73ff5b9c6008f467a7171e99c61f) - - - - - 202ba113 by Ben Gamari at 2023-02-07T19:22:09-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. (cherry picked from commit a999f7b5b4b7316c088d7233a452fb33dc17646f) - - - - - 989056f1 by Ben Gamari at 2023-02-07T19:22:09-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. (cherry picked from commit 48b89dba91640fa977d038ea5283019c73f1b18e) - - - - - 4b8c3895 by Ben Gamari at 2023-02-07T19:22:09-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive (cherry picked from commit 36ca160d0f199a688cf5fbc91d4bb92d2d4ea14e) - - - - - c254ff31 by Ben Gamari at 2023-02-07T19:22:09-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. (cherry picked from commit 8b64aff0fa978c762dfae8df235dd2b2a340656a) - - - - - 0aad9a5c by Ben Gamari at 2023-02-07T19:22:09-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. (cherry picked from commit dde67d6e32ecff0e400f98213d42ae790babac09) - - - - - 17c8d1c9 by Ben Gamari at 2023-02-07T19:22:10-05:00 nonmoving: Don't push if nonmoving collector isn't enabled (cherry picked from commit 8adc1750c02e596b4014d2837b4eb3d76bd130f2) - - - - - d219b258 by Ben Gamari at 2023-02-07T19:22:10-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. (cherry picked from commit c620669651c52fd228af61040747dd7236c4ba2b) - - - - - b8e6fe8a by Ben Gamari at 2023-02-07T19:22:10-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys (cherry picked from commit 3887132fcd20f0a1edfc9f7006bdbed2634e2a8d) - - - - - 98dab023 by Ben Gamari at 2023-02-07T19:22:10-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. (cherry picked from commit cc75031b4d93d4565e0428cb5910d9b9a645485b) - - - - - 42265945 by Ben Gamari at 2023-02-07T19:22:10-05:00 nonmoving: Add missing no-op in busy-wait loop (cherry picked from commit 9f931a8801c84b8ae473f91349e144eebc73b415) - - - - - f754705e by Ben Gamari at 2023-02-07T19:22:10-05:00 nonmoving: Move current segment array into Capability (cherry picked from commit 9d245c1baec91ee79d715062b127e487456d9c9e) - - - - - 29d392c6 by Ben Gamari at 2023-02-07T19:22:10-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. (cherry picked from commit 6bdce35cdd59112a8cb4a4a3b061e854ada3ff63) - - - - - c925ceb0 by Ben Gamari at 2023-02-07T19:22:10-05:00 nonmoving: Fix unregisterised build (cherry picked from commit 6df2709e7215ea80d7267800e0318aee2a7c277f) - - - - - b22856b2 by Ben Gamari at 2023-02-07T19:22:10-05:00 nonmoving: Avoid n_caps race (cherry picked from commit c00d6de815d4e125c1c4d8ff06549042f502f759) - - - - - 65690ab8 by Ben Gamari at 2023-02-07T19:22:10-05:00 relnotes: Mention various non-moving GC fixes - - - - - 17 changed files: - docs/users_guide/9.2.6-notes.rst - rts/Capability.c - rts/Capability.h - rts/PrimOps.cmm - rts/RtsStartup.c - rts/Schedule.c - rts/sm/Evac.c - rts/sm/GC.c - rts/sm/MarkWeak.c - rts/sm/NonMoving.c - rts/sm/NonMoving.h - rts/sm/NonMovingCensus.c - rts/sm/NonMovingCensus.h - rts/sm/NonMovingMark.c - rts/sm/NonMovingMark.h - rts/sm/Sanity.c - rts/sm/Storage.c Changes: ===================================== docs/users_guide/9.2.6-notes.rst ===================================== @@ -66,6 +66,23 @@ Runtime system - Truncate eventlog events with a large payload (:ghc-ticket:`20221`). +- A bug in the nonmoving garbage collector regarding the treatment of + zero-length ``SmallArray#``\ s has been fixed (:ghc-ticket:`22264`) + +- A number of bugs regarding the non-moving garbage collector's treatment of + ``Weak#`` pointers have been fixed (:ghc-ticket:`22327`) + +- A few race conditions between the non-moving collector and + ``setNumCapabilities`` which could result in undefined behavior have been + fixed (:ghc-ticket:`22926`, :ghc-ticket:`22927`) + +- The non-moving collector is now able to better schedule marking work during + the post-mark synchronization phase of collection, significantly reducing + pause times in some workloads (:ghc-ticket:`22929`). + +- Various bugs in the non-moving collector's implementation of the selector + optimisation have been fixed (:ghc-ticket:`22930`) + Build system and packaging -------------------------- ===================================== rts/Capability.c ===================================== @@ -294,6 +294,7 @@ initCapability (Capability *cap, uint32_t i) cap->saved_mut_lists = stgMallocBytes(sizeof(bdescr *) * RtsFlags.GcFlags.generations, "initCapability"); + cap->current_segments = NULL; // At this point storage manager is not initialized yet, so this will be @@ -1267,6 +1268,9 @@ freeCapability (Capability *cap) { stgFree(cap->mut_lists); stgFree(cap->saved_mut_lists); + if (cap->current_segments) { + stgFree(cap->current_segments); + } #if defined(THREADED_RTS) freeSparkPool(cap->sparks); #endif ===================================== rts/Capability.h ===================================== @@ -88,6 +88,9 @@ struct Capability_ { // The update remembered set for the non-moving collector UpdRemSet upd_rem_set; + // Array of current segments for the non-moving collector. + // Of length NONMOVING_ALLOCA_CNT. + struct NonmovingSegment **current_segments; // block for allocating pinned objects into bdescr *pinned_object_block; ===================================== rts/PrimOps.cmm ===================================== @@ -234,9 +234,9 @@ stg_shrinkSmallMutableArrayzh ( gcptr mba, W_ new_size ) p = mba + SIZEOF_StgSmallMutArrPtrs + WDS(new_size); end = mba + SIZEOF_StgSmallMutArrPtrs + WDS(StgSmallMutArrPtrs_ptrs(mba)); again: - ccall updateRemembSetPushClosure_(BaseReg "ptr", - W_[p] "ptr"); if (p < end) { + ccall updateRemembSetPushClosure_(BaseReg "ptr", + W_[p] "ptr"); p = p + SIZEOF_W; goto again; } ===================================== rts/RtsStartup.c ===================================== @@ -472,6 +472,7 @@ hs_exit_(bool wait_foreign) for (g = 0; g < RtsFlags.GcFlags.generations; g++) { runAllCFinalizers(generations[g].weak_ptr_list); } + runAllCFinalizers(nonmoving_weak_ptr_list); #if defined(RTS_USER_SIGNALS) if (RtsFlags.MiscFlags.install_signal_handlers) { ===================================== rts/Schedule.c ===================================== @@ -2306,7 +2306,9 @@ setNumCapabilities (uint32_t new_n_capabilities USED_IF_THREADS) moreCapabilities(n_capabilities, new_n_capabilities); // Resize and update storage manager data structures + ACQUIRE_SM_LOCK; storageAddCapabilities(n_capabilities, new_n_capabilities); + RELEASE_SM_LOCK; } } ===================================== rts/sm/Evac.c ===================================== @@ -1251,8 +1251,13 @@ selector_chain: // save any space in any case, and updating with an indirection is // trickier in a non-collected gen: we would have to update the // mutable list. - if (RELAXED_LOAD(&bd->flags) & (BF_EVACUATED | BF_NONMOVING)) { + uint16_t flags = RELAXED_LOAD(&bd->flags); + if (flags & (BF_EVACUATED | BF_NONMOVING)) { unchain_thunk_selectors(prev_thunk_selector, (StgClosure *)p); + if (flags & BF_NONMOVING) { + // See Note [Non-moving GC: Marking evacuated objects]. + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure*) p); + } *q = (StgClosure *)p; // shortcut, behave as for: if (evac) evacuate(q); if (evac && bd->gen_no < gct->evac_gen_no) { @@ -1267,7 +1272,7 @@ selector_chain: // (scavenge_mark_stack doesn't deal with IND). BEWARE! This // bit is very tricky to get right. If you make changes // around here, test by compiling stage 3 with +RTS -c -RTS. - if (bd->flags & BF_MARKED) { + if (flags & BF_MARKED) { // must call evacuate() to mark this closure if evac==true *q = (StgClosure *)p; if (evac) evacuate(q); @@ -1307,6 +1312,12 @@ selector_chain: // - undo the chain we've built to point to p. SET_INFO((StgClosure *)p, (const StgInfoTable *)info_ptr); RELEASE_STORE(q, (StgClosure *) p); + if (Bdescr((StgPtr)p)->flags & BF_NONMOVING) { + // See Note [Non-moving GC: Marking evacuated objects]. + // TODO: This really shouldn't be necessary since whoever won + // the race should have pushed + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure*) p); + } if (evac) evacuate(q); unchain_thunk_selectors(prev_thunk_selector, (StgClosure *)p); return; @@ -1397,6 +1408,11 @@ selector_loop: case THUNK_SELECTOR: // Use payload to make a list of thunk selectors, to be // used in unchain_thunk_selectors + // + // FIXME: This seems racy; should we lock this selector to + // ensure that another thread doesn't clobber this node + // of the chain. This would result in some previous + // selectors not being updated when we unchain. RELAXED_STORE(&((StgClosure*)p)->payload[0], (StgClosure *)prev_thunk_selector); prev_thunk_selector = p; p = (StgSelector*)val; @@ -1421,6 +1437,12 @@ selector_loop: // eval_thunk_selector(), because we know val is not // a THUNK_SELECTOR. if (evac) evacuate(q); + + if (isNonmovingClosure(*q)) { + // See Note [Non-moving GC: Marking evacuated objects]. + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure*) *q); + } + return; } @@ -1465,6 +1487,10 @@ selector_loop: // recurse indefinitely, so we impose a depth bound. // See Note [Selector optimisation depth limit]. if (gct->thunk_selector_depth >= MAX_THUNK_SELECTOR_DEPTH) { + if (isNonmovingClosure((StgClosure *) p)) { + // See Note [Non-moving GC: Marking evacuated objects]. + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure*) p); + } goto bale_out; } @@ -1511,5 +1537,9 @@ bale_out: if (evac) { copy(q,(const StgInfoTable *)info_ptr,(StgClosure *)p,THUNK_SELECTOR_sizeW(),bd->dest_no); } + if (isNonmovingClosure(*q)) { + // See Note [Non-moving GC: Marking evacuated objects]. + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, *q); + } unchain_thunk_selectors(prev_thunk_selector, *q); } ===================================== rts/sm/GC.c ===================================== @@ -375,7 +375,8 @@ GarbageCollect (uint32_t collect_gen, static_flag == STATIC_FLAG_A ? STATIC_FLAG_B : STATIC_FLAG_A; } - if (major_gc) { + /* N.B. We currently don't unload code with the non-moving collector. */ + if (major_gc && !RtsFlags.GcFlags.useNonmoving) { unload_mark_needed = prepareUnloadCheck(); } else { unload_mark_needed = false; @@ -846,11 +847,9 @@ GarbageCollect (uint32_t collect_gen, // Flush the update remembered sets. See Note [Eager update remembered set // flushing] in NonMovingMark.c if (RtsFlags.GcFlags.useNonmoving) { - RELEASE_SM_LOCK; for (n = 0; n < getNumCapabilities(); n++) { - nonmovingAddUpdRemSetBlocks(&capabilities[n]->upd_rem_set.queue); + nonmovingAddUpdRemSetBlocks(&capabilities[n]->upd_rem_set); } - ACQUIRE_SM_LOCK; } // Mark and sweep the oldest generation. @@ -871,8 +870,6 @@ GarbageCollect (uint32_t collect_gen, // old_weak_ptr_list should be empty. ASSERT(oldest_gen->old_weak_ptr_list == NULL); - // we may need to take the lock to allocate mark queue blocks - RELEASE_SM_LOCK; // dead_weak_ptr_list contains weak pointers with dead keys. Those need to // be kept alive because we'll use them in finalizeSchedulers(). Similarly // resurrected_threads are also going to be used in resurrectedThreads() @@ -882,10 +879,9 @@ GarbageCollect (uint32_t collect_gen, #if !defined(THREADED_RTS) // In the non-threaded runtime this is the only time we push to the // upd_rem_set - nonmovingAddUpdRemSetBlocks(&gct->cap->upd_rem_set.queue); + nonmovingAddUpdRemSetBlocks(&gct->cap->upd_rem_set); #endif nonmovingCollect(&dead_weak_ptr_list, &resurrected_threads); - ACQUIRE_SM_LOCK; } // Update the max size of older generations after a major GC: ===================================== rts/sm/MarkWeak.c ===================================== @@ -50,7 +50,7 @@ - weak_stage == WeakPtrs - We process all the weak pointers whos keys are alive (evacuate + We process all the weak pointers whose keys are alive (evacuate their values and finalizers), and repeat until we can find no new live keys. If no live keys are found in this pass, then we evacuate the finalizers of all the dead weak pointers in order to @@ -82,12 +82,46 @@ static bool tidyWeakList (generation *gen); static bool resurrectUnreachableThreads (generation *gen, StgTSO **resurrected_threads); static void tidyThreadList (generation *gen); +/* + * Note [Weak pointer processing and the non-moving GC] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * When using the non-moving GC we defer weak pointer processing + * until the concurrent marking phase as weaks in the non-moving heap may be + * keyed on objects living in the non-moving generation. To accomplish this + * initWeakForGC keeps all weak pointers on oldest_gen->weak_ptr_list, where + * nonmovingCollect will find them. From there they will be moved to + * nonmoving_old_weak_ptr_list. During the mark loop we will move weaks with + * reachable keys to nonmoving_weak_ptr_list. At the end of concurrent marking + * we tidy the weak list (in nonmovingTidyWeakList) and perform another set of + * marking as necessary, just as is done in tidyWeakList. + * + * Note that this treatment takes advantage of the fact that we usually need + * not worry about Weak#s living in the non-moving heap but being keyed on an + * object in the moving heap since the Weak# must be strictly older than the + * key. Such objects would otherwise pose a problem since the non-moving + * collector would be unable to safely determine the liveness of the key. + * In the rare case that we *do* see such a key (e.g. in the case of a + * pinned ByteArray# living in a partially-filled accumulator block) + * the nonmoving collector assumes that it is live. + * + */ + +/* + * Prepare the weak object lists for GC. Specifically, reset weak_stage + * and move all generations' `weak_ptr_list`s to `old_weak_ptr_list`. + * Weaks with live keys will later be moved back to `weak_ptr_list` by + * `tidyWeakList`. + */ void initWeakForGC(void) { - uint32_t g; + uint32_t oldest = N; + if (RtsFlags.GcFlags.useNonmoving && N == oldest_gen->no) { + // See Note [Weak pointer processing and the non-moving GC]. + oldest = oldest_gen->no - 1; + } - for (g = 0; g <= N; g++) { + for (uint32_t g = 0; g <= oldest; g++) { generation *gen = &generations[g]; gen->old_weak_ptr_list = gen->weak_ptr_list; gen->weak_ptr_list = NULL; @@ -96,6 +130,14 @@ initWeakForGC(void) weak_stage = WeakThreads; } +/* + * Walk the weak pointer lists after having finished a round of scavenging, + * tidying the weak (and possibly thread) lists (depending upon the current + * weak_stage). + * + * Returns true if new live weak pointers were found, implying that another + * round of scavenging is necessary. + */ bool traverseWeakPtrList(StgWeak **dead_weak_ptr_list, StgTSO **resurrected_threads) { @@ -182,6 +224,11 @@ traverseWeakPtrList(StgWeak **dead_weak_ptr_list, StgTSO **resurrected_threads) } } +/* + * Deal with weak pointers with unreachable keys after GC has concluded. + * This means marking the finalizer (and possibly value) in preparation for + * later finalization. + */ static void collectDeadWeakPtrs (generation *gen, StgWeak **dead_weak_ptr_list) { StgWeak *w, *next_w; @@ -198,6 +245,10 @@ static void collectDeadWeakPtrs (generation *gen, StgWeak **dead_weak_ptr_list) } } +/* + * Deal with threads left on the old_threads list after GC has concluded, + * moving them onto the resurrected_threads list where appropriate. + */ static bool resurrectUnreachableThreads (generation *gen, StgTSO **resurrected_threads) { StgTSO *t, *tmp, *next; @@ -233,8 +284,21 @@ static bool resurrectUnreachableThreads (generation *gen, StgTSO **resurrected_t return flag; } +/* + * Walk over the `old_weak_ptr_list` of the given generation and: + * + * - remove any DEAD_WEAKs + * - move any weaks with reachable keys to the `weak_ptr_list` of the + * appropriate to-space and mark the weak's value and finalizer. + */ static bool tidyWeakList(generation *gen) { + if (RtsFlags.GcFlags.useNonmoving && gen == oldest_gen) { + // See Note [Weak pointer processing and the non-moving GC]. + ASSERT(gen->old_weak_ptr_list == NULL); + return false; + } + StgWeak *w, **last_w, *next_w; const StgInfoTable *info; StgClosure *new; @@ -322,6 +386,10 @@ static bool tidyWeakList(generation *gen) return flag; } +/* + * Walk over the `old_threads` list of the given generation and move any + * reachable threads onto the `threads` list. + */ static void tidyThreadList (generation *gen) { StgTSO *t, *tmp, *next, **prev; @@ -381,6 +449,10 @@ static void checkWeakPtrSanity(StgWeak *hd, StgWeak *tl) } #endif +/* + * Traverse the capabilities' local new-weak-pointer lists at the beginning of + * GC and move them to the nursery's weak_ptr_list. + */ void collectFreshWeakPtrs() { uint32_t i; ===================================== rts/sm/NonMoving.c ===================================== @@ -244,6 +244,12 @@ Mutex concurrent_coll_finished_lock; * how we use the DIRTY flags associated with MUT_VARs and TVARs to improve * barrier efficiency. * + * - Note [Weak pointer processing and the non-moving GC] (MarkWeak.c) describes + * how weak pointers are handled when the non-moving GC is in use. + * + * - Note [Sync phase marking budget] describes how we avoid long mutator + * pauses during the sync phase + * * [ueno 2016]: * Katsuhiro Ueno and Atsushi Ohori. 2016. A fully concurrent garbage * collector for functional programs on multicore processors. SIGPLAN Not. 51, @@ -292,6 +298,7 @@ Mutex concurrent_coll_finished_lock; * ┆ * B ←────────────── A ←─────────────── root * │ ┆ ↖─────────────── gen1 mut_list + * │ ┆ * ╰───────────────→ C * ┆ * @@ -332,6 +339,7 @@ Mutex concurrent_coll_finished_lock; * The implementation details of this are described in Note [Non-moving GC: * Marking evacuated objects] in Evac.c. * + * * Note [Deadlock detection under the non-moving collector] * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ * In GHC the garbage collector is responsible for identifying deadlocked @@ -493,10 +501,44 @@ Mutex concurrent_coll_finished_lock; * remembered set during the preparatory GC. This allows us to safely skip the * non-moving write barrier without jeopardizing the snapshot invariant. * + * + * Note [Sync phase marking budget] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * The non-moving collector is intended to provide reliably low collection + * latencies. These latencies are primarily due to two sources: + * + * a. the preparatory moving collection at the beginning of the major GC cycle + * b. the post-mark synchronization pause at the end + * + * While the cost of (a) is inherently bounded by the young generation size, + * (b) can in principle be unbounded since the mutator may hide large swathes + * of heap from the collector's concurrent mark phase via mutation. These will + * only become visible to the collector during the post-mark synchronization + * phase. + * + * Since we don't want to do unbounded marking work in the pause, we impose a + * limit (specifically, sync_phase_marking_budget) on the amount of work + * (namely, the number of marked closures) that we can do during the pause. If + * we deplete our marking budget during the pause then we allow the mutators to + * resume and return to concurrent marking (keeping the update remembered set + * write barrier enabled). After we have finished marking we will again + * attempt the post-mark synchronization. + * + * The choice of sync_phase_marking_budget was made empirically. On 2022 + * hardware and a "typical" test program we tend to mark ~10^7 closures per + * second. Consequently, a sync_phase_marking_budget of 10^5 should produce + * ~10 ms pauses, which seems like a reasonable tradeoff. + * + * TODO: Perhaps sync_phase_marking_budget should be controllable via a + * command-line argument? + * */ memcount nonmoving_live_words = 0; +// See Note [Sync phase marking budget]. +MarkBudget sync_phase_marking_budget = 200000; + #if defined(THREADED_RTS) static void* nonmovingConcurrentMark(void *mark_queue); #endif @@ -665,10 +707,11 @@ void *nonmovingAllocate(Capability *cap, StgWord sz) // object and not moved) which is covered by allocator 9. ASSERT(log_block_size < NONMOVING_ALLOCA0 + NONMOVING_ALLOCA_CNT); - struct NonmovingAllocator *alloca = nonmovingHeap.allocators[log_block_size - NONMOVING_ALLOCA0]; + unsigned int alloca_idx = log_block_size - NONMOVING_ALLOCA0; + struct NonmovingAllocator *alloca = &nonmovingHeap.allocators[alloca_idx]; // Allocate into current segment - struct NonmovingSegment *current = alloca->current[cap->no]; + struct NonmovingSegment *current = cap->current_segments[alloca_idx]; ASSERT(current); // current is never NULL void *ret = nonmovingSegmentGetBlock_(current, log_block_size, current->next_free); ASSERT(GET_CLOSURE_TAG(ret) == 0); // check alignment @@ -701,29 +744,12 @@ void *nonmovingAllocate(Capability *cap, StgWord sz) // make it current new_current->link = NULL; SET_SEGMENT_STATE(new_current, CURRENT); - alloca->current[cap->no] = new_current; + cap->current_segments[alloca_idx] = new_current; } return ret; } -/* Allocate a nonmovingAllocator */ -static struct NonmovingAllocator *alloc_nonmoving_allocator(uint32_t n_caps) -{ - size_t allocator_sz = - sizeof(struct NonmovingAllocator) + - sizeof(void*) * n_caps; // current segment pointer for each capability - struct NonmovingAllocator *alloc = - stgMallocBytes(allocator_sz, "nonmovingInit"); - memset(alloc, 0, allocator_sz); - return alloc; -} - -static void free_nonmoving_allocator(struct NonmovingAllocator *alloc) -{ - stgFree(alloc); -} - void nonmovingInit(void) { if (! RtsFlags.GcFlags.useNonmoving) return; @@ -732,10 +758,7 @@ void nonmovingInit(void) initCondition(&concurrent_coll_finished); initMutex(&concurrent_coll_finished_lock); #endif - for (unsigned int i = 0; i < NONMOVING_ALLOCA_CNT; i++) { - nonmovingHeap.allocators[i] = alloc_nonmoving_allocator(getNumCapabilities()); - } - nonmovingMarkInitUpdRemSet(); + nonmovingMarkInit(); } // Stop any nonmoving collection in preparation for RTS shutdown. @@ -764,44 +787,24 @@ void nonmovingExit(void) closeCondition(&concurrent_coll_finished); closeMutex(&nonmoving_collection_mutex); #endif - - for (unsigned int i = 0; i < NONMOVING_ALLOCA_CNT; i++) { - free_nonmoving_allocator(nonmovingHeap.allocators[i]); - } } -/* - * Assumes that no garbage collector or mutator threads are running to safely - * resize the nonmoving_allocators. - * - * Must hold sm_mutex. - */ -void nonmovingAddCapabilities(uint32_t new_n_caps) +/* Initialize a new capability. Caller must hold SM_LOCK */ +void nonmovingInitCapability(Capability *cap) { - unsigned int old_n_caps = nonmovingHeap.n_caps; - struct NonmovingAllocator **allocs = nonmovingHeap.allocators; - + // Initialize current segment array + struct NonmovingSegment **segs = + stgMallocBytes(sizeof(struct NonmovingSegment*) * NONMOVING_ALLOCA_CNT, "current segment array"); for (unsigned int i = 0; i < NONMOVING_ALLOCA_CNT; i++) { - struct NonmovingAllocator *old = allocs[i]; - allocs[i] = alloc_nonmoving_allocator(new_n_caps); - - // Copy the old state - allocs[i]->filled = old->filled; - allocs[i]->active = old->active; - for (unsigned int j = 0; j < old_n_caps; j++) { - allocs[i]->current[j] = old->current[j]; - } - stgFree(old); - - // Initialize current segments for the new capabilities - for (unsigned int j = old_n_caps; j < new_n_caps; j++) { - allocs[i]->current[j] = nonmovingAllocSegment(capabilities[j]->node); - nonmovingInitSegment(allocs[i]->current[j], NONMOVING_ALLOCA0 + i); - SET_SEGMENT_STATE(allocs[i]->current[j], CURRENT); - allocs[i]->current[j]->link = NULL; - } + segs[i] = nonmovingAllocSegment(cap->node); + nonmovingInitSegment(segs[i], NONMOVING_ALLOCA0 + i); + SET_SEGMENT_STATE(segs[i], CURRENT); } - nonmovingHeap.n_caps = new_n_caps; + cap->current_segments = segs; + + // Initialize update remembered set + cap->upd_rem_set.queue.blocks = NULL; + nonmovingInitUpdRemSet(&cap->upd_rem_set); } void nonmovingClearBitmap(struct NonmovingSegment *seg) @@ -821,18 +824,21 @@ static void nonmovingPrepareMark(void) // Should have been cleared by the last sweep ASSERT(nonmovingHeap.sweep_list == NULL); + nonmovingHeap.n_caps = n_capabilities; nonmovingBumpEpoch(); for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { - struct NonmovingAllocator *alloca = nonmovingHeap.allocators[alloca_idx]; + struct NonmovingAllocator *alloca = &nonmovingHeap.allocators[alloca_idx]; // Update current segments' snapshot pointers - for (uint32_t cap_n = 0; cap_n < getNumCapabilities(); ++cap_n) { - struct NonmovingSegment *seg = alloca->current[cap_n]; + for (uint32_t cap_n = 0; cap_n < nonmovingHeap.n_caps; ++cap_n) { + Capability *cap = capabilities[cap_n]; + struct NonmovingSegment *seg = cap->current_segments[alloca_idx]; nonmovingSegmentInfo(seg)->next_free_snap = seg->next_free; } // Save the filled segments for later processing during the concurrent // mark phase. + ASSERT(alloca->saved_filled == NULL); alloca->saved_filled = alloca->filled; alloca->filled = NULL; @@ -886,37 +892,6 @@ static void nonmovingPrepareMark(void) #endif } -// Mark weak pointers in the non-moving heap. They'll either end up in -// dead_weak_ptr_list or stay in weak_ptr_list. Either way they need to be kept -// during sweep. See `MarkWeak.c:markWeakPtrList` for the moving heap variant -// of this. -static void nonmovingMarkWeakPtrList(MarkQueue *mark_queue, StgWeak *dead_weak_ptr_list) -{ - for (StgWeak *w = oldest_gen->weak_ptr_list; w; w = w->link) { - markQueuePushClosure_(mark_queue, (StgClosure*)w); - // Do not mark finalizers and values here, those fields will be marked - // in `nonmovingMarkDeadWeaks` (for dead weaks) or - // `nonmovingTidyWeaks` (for live weaks) - } - - // We need to mark dead_weak_ptr_list too. This is subtle: - // - // - By the beginning of this GC we evacuated all weaks to the non-moving - // heap (in `markWeakPtrList`) - // - // - During the scavenging of the moving heap we discovered that some of - // those weaks are dead and moved them to `dead_weak_ptr_list`. Note that - // because of the fact above _all weaks_ are in the non-moving heap at - // this point. - // - // - So, to be able to traverse `dead_weak_ptr_list` and run finalizers we - // need to mark it. - for (StgWeak *w = dead_weak_ptr_list; w; w = w->link) { - markQueuePushClosure_(mark_queue, (StgClosure*)w); - nonmovingMarkDeadWeak(mark_queue, w); - } -} - void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) { #if defined(THREADED_RTS) @@ -939,6 +914,7 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) ASSERT(n_nonmoving_marked_compact_blocks == 0); MarkQueue *mark_queue = stgMallocBytes(sizeof(MarkQueue), "mark queue"); + mark_queue->blocks = NULL; initMarkQueue(mark_queue); current_mark_queue = mark_queue; @@ -950,12 +926,19 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) capabilities[n], true/*don't mark sparks*/); } markScheduler((evac_fn)markQueueAddRoot, mark_queue); - nonmovingMarkWeakPtrList(mark_queue, *dead_weaks); markStablePtrTable((evac_fn)markQueueAddRoot, mark_queue); + // The dead weak pointer list shouldn't contain any weaks in the + // nonmoving heap +#if defined(DEBUG) + for (StgWeak *w = *dead_weaks; w; w = w->link) { + ASSERT(Bdescr((StgPtr) w)->gen != oldest_gen); + } +#endif + // Mark threads resurrected during moving heap scavenging for (StgTSO *tso = *resurrected_threads; tso != END_TSO_QUEUE; tso = tso->global_link) { - markQueuePushClosure_(mark_queue, (StgClosure*)tso); + markQueuePushClosureGC(mark_queue, (StgClosure*)tso); } trace(TRACE_nonmoving_gc, "Finished marking roots for nonmoving GC"); @@ -978,8 +961,23 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) // alive). ASSERT(oldest_gen->old_weak_ptr_list == NULL); ASSERT(nonmoving_old_weak_ptr_list == NULL); - nonmoving_old_weak_ptr_list = oldest_gen->weak_ptr_list; - oldest_gen->weak_ptr_list = NULL; + { + // Move both oldest_gen->weak_ptr_list and nonmoving_weak_ptr_list to + // nonmoving_old_weak_ptr_list + StgWeak **weaks = &oldest_gen->weak_ptr_list; + uint32_t n = 0; + while (*weaks) { + weaks = &(*weaks)->link; + n++; + } + debugTrace(DEBUG_nonmoving_gc, "%d new nonmoving weaks", n); + *weaks = nonmoving_weak_ptr_list; + nonmoving_old_weak_ptr_list = oldest_gen->weak_ptr_list; + nonmoving_weak_ptr_list = NULL; + oldest_gen->weak_ptr_list = NULL; + // At this point all weaks in the nonmoving generation are on + // nonmoving_old_weak_ptr_list + } trace(TRACE_nonmoving_gc, "Finished nonmoving GC preparation"); // We are now safe to start concurrent marking @@ -1015,19 +1013,25 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) } /* Mark queue, threads, and weak pointers until no more weaks have been - * resuscitated + * resuscitated. If *budget is non-zero then we will mark no more than + * Returns true if we there is no more marking work to be done, false if + * we exceeded our marking budget. */ -static void nonmovingMarkThreadsWeaks(MarkQueue *mark_queue) +static bool nonmovingMarkThreadsWeaks(MarkBudget *budget, MarkQueue *mark_queue) { while (true) { // Propagate marks - nonmovingMark(mark_queue); + nonmovingMark(budget, mark_queue); + if (*budget == 0) { + return false; + } // Tidy threads and weaks nonmovingTidyThreads(); - if (! nonmovingTidyWeaks(mark_queue)) - return; + if (! nonmovingTidyWeaks(mark_queue)) { + return true; + } } } @@ -1041,7 +1045,6 @@ static void* nonmovingConcurrentMark(void *data) return NULL; } -// TODO: Not sure where to put this function. // Append w2 to the end of w1. static void appendWeakList( StgWeak **w1, StgWeak *w2 ) { @@ -1061,28 +1064,40 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * // Walk the list of filled segments that we collected during preparation, // updated their snapshot pointers and move them to the sweep list. for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { - struct NonmovingSegment *filled = nonmovingHeap.allocators[alloca_idx]->saved_filled; + struct NonmovingSegment *filled = nonmovingHeap.allocators[alloca_idx].saved_filled; uint32_t n_filled = 0; if (filled) { struct NonmovingSegment *seg = filled; while (true) { // Set snapshot nonmovingSegmentInfo(seg)->next_free_snap = seg->next_free; + SET_SEGMENT_STATE(seg, FILLED_SWEEPING); n_filled++; - if (seg->link) + if (seg->link) { seg = seg->link; - else + } else { break; + } } // add filled segments to sweep_list - SET_SEGMENT_STATE(seg, FILLED_SWEEPING); seg->link = nonmovingHeap.sweep_list; nonmovingHeap.sweep_list = filled; } + nonmovingHeap.allocators[alloca_idx].saved_filled = NULL; } + // Mark Weak#s + nonmovingMarkWeakPtrList(mark_queue); + // Do concurrent marking; most of the heap will get marked here. - nonmovingMarkThreadsWeaks(mark_queue); + +#if defined(THREADED_RTS) +concurrent_marking: +#endif + { + MarkBudget budget = UNLIMITED_MARK_BUDGET; + nonmovingMarkThreadsWeaks(&budget, mark_queue); + } #if defined(THREADED_RTS) Task *task = newBoundTask(); @@ -1091,21 +1106,13 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * if (sched_state > SCHED_RUNNING) { // Note that we break our invariants here and leave segments in // nonmovingHeap.sweep_list, don't free nonmoving_large_objects etc. - // However because we won't be running mark-sweep in the final GC this + // However because we won't be running sweep in the final GC this // is OK. - - // This is a RTS shutdown so we need to move our copy (snapshot) of - // weaks (nonmoving_old_weak_ptr_list and nonmoving_weak_ptr_list) to - // oldest_gen->threads to be able to run C finalizers in hs_exit_. Note - // that there may be more weaks added to oldest_gen->threads since we - // started mark, so we need to append our list to the tail of - // oldest_gen->threads. - appendWeakList(&nonmoving_old_weak_ptr_list, nonmoving_weak_ptr_list); - appendWeakList(&oldest_gen->weak_ptr_list, nonmoving_old_weak_ptr_list); - // These lists won't be used again so this is not necessary, but still - nonmoving_old_weak_ptr_list = NULL; - nonmoving_weak_ptr_list = NULL; - + // + // However, we must move any weak pointers remaining on + // nonmoving_old_weak_ptr_list back to nonmoving_weak_ptr_list + // such that their C finalizers can be run by hs_exit_. + appendWeakList(&nonmoving_weak_ptr_list, nonmoving_old_weak_ptr_list); goto finish; } @@ -1113,9 +1120,17 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * nonmovingBeginFlush(task); bool all_caps_syncd; + MarkBudget sync_marking_budget = sync_phase_marking_budget; do { all_caps_syncd = nonmovingWaitForFlush(); - nonmovingMarkThreadsWeaks(mark_queue); + if (nonmovingMarkThreadsWeaks(&sync_marking_budget, mark_queue) == false) { + // We ran out of budget for marking. Abort sync. + // See Note [Sync phase marking budget]. + traceConcSyncEnd(); + stat_endNonmovingGcSync(); + releaseAllCapabilities(n_capabilities, NULL, task); + goto concurrent_marking; + } } while (!all_caps_syncd); #endif @@ -1126,7 +1141,7 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * // Do last marking of weak pointers while (true) { // Propagate marks - nonmovingMark(mark_queue); + nonmovingMarkUnlimitedBudget(mark_queue); if (!nonmovingTidyWeaks(mark_queue)) break; @@ -1135,7 +1150,7 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * nonmovingMarkDeadWeaks(mark_queue, dead_weaks); // Propagate marks - nonmovingMark(mark_queue); + nonmovingMarkUnlimitedBudget(mark_queue); // Now remove all dead objects from the mut_list to ensure that a younger // generation collection doesn't attempt to look at them after we've swept. @@ -1177,15 +1192,9 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * nonmoving_old_threads = END_TSO_QUEUE; } - { - StgWeak **weaks = &oldest_gen->weak_ptr_list; - while (*weaks) { - weaks = &(*weaks)->link; - } - *weaks = nonmoving_weak_ptr_list; - nonmoving_weak_ptr_list = NULL; - nonmoving_old_weak_ptr_list = NULL; - } + // At this point point any weak that remains on nonmoving_old_weak_ptr_list + // has a dead key. + nonmoving_old_weak_ptr_list = NULL; // Prune spark lists // See Note [Spark management under the nonmoving collector]. @@ -1283,10 +1292,12 @@ void assert_in_nonmoving_heap(StgPtr p) } for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { - struct NonmovingAllocator *alloca = nonmovingHeap.allocators[alloca_idx]; + struct NonmovingAllocator *alloca = &nonmovingHeap.allocators[alloca_idx]; + // Search current segments - for (uint32_t cap_idx = 0; cap_idx < getNumCapabilities(); ++cap_idx) { - struct NonmovingSegment *seg = alloca->current[cap_idx]; + for (uint32_t cap_idx = 0; cap_idx < nonmovingHeap.n_caps; ++cap_idx) { + Capability *cap = capabilities[cap_idx]; + struct NonmovingSegment *seg = cap->current_segments[alloca_idx]; if (p >= (P_)seg && p < (((P_)seg) + NONMOVING_SEGMENT_SIZE_W)) { return; } @@ -1345,33 +1356,16 @@ void nonmovingPrintSegment(struct NonmovingSegment *seg) debugBelch("End of segment\n\n"); } -void nonmovingPrintAllocator(struct NonmovingAllocator *alloc) -{ - debugBelch("Allocator at %p\n", (void*)alloc); - debugBelch("Filled segments:\n"); - for (struct NonmovingSegment *seg = alloc->filled; seg != NULL; seg = seg->link) { - debugBelch("%p ", (void*)seg); - } - debugBelch("\nActive segments:\n"); - for (struct NonmovingSegment *seg = alloc->active; seg != NULL; seg = seg->link) { - debugBelch("%p ", (void*)seg); - } - debugBelch("\nCurrent segments:\n"); - for (uint32_t i = 0; i < getNumCapabilities(); ++i) { - debugBelch("%p ", alloc->current[i]); - } - debugBelch("\n"); -} - void locate_object(P_ obj) { // Search allocators for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { - struct NonmovingAllocator *alloca = nonmovingHeap.allocators[alloca_idx]; - for (uint32_t cap = 0; cap < getNumCapabilities(); ++cap) { - struct NonmovingSegment *seg = alloca->current[cap]; + struct NonmovingAllocator *alloca = &nonmovingHeap.allocators[alloca_idx]; + for (uint32_t cap_n = 0; cap_n < nonmovingHeap.n_caps; ++cap_n) { + Capability *cap = capabilities[cap_n]; + struct NonmovingSegment *seg = cap->current_segments[alloca_idx]; if (obj >= (P_)seg && obj < (((P_)seg) + NONMOVING_SEGMENT_SIZE_W)) { - debugBelch("%p is in current segment of capability %d of allocator %d at %p\n", obj, cap, alloca_idx, (void*)seg); + debugBelch("%p is in current segment of capability %d of allocator %d at %p\n", obj, cap_n, alloca_idx, (void*)seg); return; } } ===================================== rts/sm/NonMoving.h ===================================== @@ -84,8 +84,7 @@ struct NonmovingAllocator { struct NonmovingSegment *filled; struct NonmovingSegment *saved_filled; struct NonmovingSegment *active; - // indexed by capability number - struct NonmovingSegment *current[]; + // N.B. Per-capabilty "current" segment lives in Capability }; // first allocator is of size 2^NONMOVING_ALLOCA0 (in bytes) @@ -99,7 +98,7 @@ struct NonmovingAllocator { #define NONMOVING_MAX_FREE 16 struct NonmovingHeap { - struct NonmovingAllocator *allocators[NONMOVING_ALLOCA_CNT]; + struct NonmovingAllocator allocators[NONMOVING_ALLOCA_CNT]; // free segment list. This is a cache where we keep up to // NONMOVING_MAX_FREE segments to avoid thrashing the block allocator. // Note that segments in this list are still counted towards @@ -149,7 +148,7 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads); void *nonmovingAllocate(Capability *cap, StgWord sz); -void nonmovingAddCapabilities(uint32_t new_n_caps); +void nonmovingInitCapability(Capability *cap); void nonmovingPushFreeSegment(struct NonmovingSegment *seg); void nonmovingClearBitmap(struct NonmovingSegment *seg); @@ -166,7 +165,7 @@ INLINE_HEADER uint8_t nonmovingSegmentLogBlockSize(struct NonmovingSegment *seg) INLINE_HEADER void nonmovingPushActiveSegment(struct NonmovingSegment *seg) { struct NonmovingAllocator *alloc = - nonmovingHeap.allocators[nonmovingSegmentLogBlockSize(seg) - NONMOVING_ALLOCA0]; + &nonmovingHeap.allocators[nonmovingSegmentLogBlockSize(seg) - NONMOVING_ALLOCA0]; SET_SEGMENT_STATE(seg, ACTIVE); while (true) { struct NonmovingSegment *current_active = (struct NonmovingSegment*)VOLATILE_LOAD(&alloc->active); @@ -181,7 +180,7 @@ INLINE_HEADER void nonmovingPushActiveSegment(struct NonmovingSegment *seg) INLINE_HEADER void nonmovingPushFilledSegment(struct NonmovingSegment *seg) { struct NonmovingAllocator *alloc = - nonmovingHeap.allocators[nonmovingSegmentLogBlockSize(seg) - NONMOVING_ALLOCA0]; + &nonmovingHeap.allocators[nonmovingSegmentLogBlockSize(seg) - NONMOVING_ALLOCA0]; SET_SEGMENT_STATE(seg, FILLED); while (true) { struct NonmovingSegment *current_filled = (struct NonmovingSegment*)VOLATILE_LOAD(&alloc->filled); @@ -289,20 +288,17 @@ INLINE_HEADER void nonmovingSetClosureMark(StgPtr p) nonmovingSetMark(nonmovingGetSegment(p), nonmovingGetBlockIdx(p)); } -// TODO: Audit the uses of these -/* Was the given closure marked this major GC cycle? */ -INLINE_HEADER bool nonmovingClosureMarkedThisCycle(StgPtr p) +INLINE_HEADER uint8_t nonmovingGetClosureMark(StgPtr p) { struct NonmovingSegment *seg = nonmovingGetSegment(p); nonmoving_block_idx blk_idx = nonmovingGetBlockIdx(p); - return nonmovingGetMark(seg, blk_idx) == nonmovingMarkEpoch; + return nonmovingGetMark(seg, blk_idx); } -INLINE_HEADER bool nonmovingClosureMarked(StgPtr p) +/* Was the given closure marked this major GC cycle? */ +INLINE_HEADER bool nonmovingClosureMarkedThisCycle(StgPtr p) { - struct NonmovingSegment *seg = nonmovingGetSegment(p); - nonmoving_block_idx blk_idx = nonmovingGetBlockIdx(p); - return nonmovingGetMark(seg, blk_idx) != 0; + return nonmovingGetClosureMark(p) == nonmovingMarkEpoch; } // Can be called during a major collection to determine whether a particular @@ -336,10 +332,14 @@ INLINE_HEADER bool nonmovingClosureBeingSwept(StgClosure *p) } } +// N.B. RtsFlags is defined as a pointer in STG code consequently this code +// doesn't typecheck. +#if !IN_STG_CODE INLINE_HEADER bool isNonmovingClosure(StgClosure *p) { - return !HEAP_ALLOCED_GC(p) || Bdescr((P_)p)->flags & BF_NONMOVING; + return RtsFlags.GcFlags.useNonmoving && (!HEAP_ALLOCED_GC(p) || Bdescr((P_)p)->flags & BF_NONMOVING); } +#endif #if defined(DEBUG) ===================================== rts/sm/NonMovingCensus.c ===================================== @@ -21,10 +21,12 @@ // stopped. In this case is safe to look at active and current segments so we can // also collect statistics on live words. static struct NonmovingAllocCensus -nonmovingAllocatorCensus_(struct NonmovingAllocator *alloc, bool collect_live_words) +nonmovingAllocatorCensus_(uint32_t alloc_idx, bool collect_live_words) { struct NonmovingAllocCensus census = {collect_live_words, 0, 0, 0, 0}; + struct NonmovingAllocator *alloc = &nonmovingHeap.allocators[alloc_idx]; + // filled segments for (struct NonmovingSegment *seg = alloc->filled; seg != NULL; seg = seg->link) @@ -40,6 +42,7 @@ nonmovingAllocatorCensus_(struct NonmovingAllocator *alloc, bool collect_live_wo } } + // active segments for (struct NonmovingSegment *seg = alloc->active; seg != NULL; seg = seg->link) @@ -56,9 +59,11 @@ nonmovingAllocatorCensus_(struct NonmovingAllocator *alloc, bool collect_live_wo } } - for (unsigned int cap=0; cap < getNumCapabilities(); cap++) + // current segments + for (unsigned int cap_n=0; cap_n < getNumCapabilities(); cap_n++) { - struct NonmovingSegment *seg = alloc->current[cap]; + Capability *cap = capabilities[cap_n]; + struct NonmovingSegment *seg = cap->current_segments[alloc_idx]; unsigned int n = nonmovingSegmentBlockCount(seg); for (unsigned int i=0; i < n; i++) { if (nonmovingGetMark(seg, i)) { @@ -76,15 +81,15 @@ nonmovingAllocatorCensus_(struct NonmovingAllocator *alloc, bool collect_live_wo * all blocks in nonmoving heap are valid closures. */ struct NonmovingAllocCensus -nonmovingAllocatorCensusWithWords(struct NonmovingAllocator *alloc) +nonmovingAllocatorCensusWithWords(uint32_t alloc_idx) { - return nonmovingAllocatorCensus_(alloc, true); + return nonmovingAllocatorCensus_(alloc_idx, true); } struct NonmovingAllocCensus -nonmovingAllocatorCensus(struct NonmovingAllocator *alloc) +nonmovingAllocatorCensus(uint32_t alloc_idx) { - return nonmovingAllocatorCensus_(alloc, false); + return nonmovingAllocatorCensus_(alloc_idx, false); } @@ -130,7 +135,7 @@ void nonmovingPrintAllocatorCensus(bool collect_live_words) for (int i=0; i < NONMOVING_ALLOCA_CNT; i++) { struct NonmovingAllocCensus census = - nonmovingAllocatorCensus_(nonmovingHeap.allocators[i], collect_live_words); + nonmovingAllocatorCensus_(i, collect_live_words); print_alloc_census(i, census); } @@ -143,8 +148,7 @@ void nonmovingTraceAllocatorCensus() return; for (int i=0; i < NONMOVING_ALLOCA_CNT; i++) { - const struct NonmovingAllocCensus census = - nonmovingAllocatorCensus(nonmovingHeap.allocators[i]); + const struct NonmovingAllocCensus census = nonmovingAllocatorCensus(i); const uint32_t log_blk_size = i + NONMOVING_ALLOCA0; traceNonmovingHeapCensus(log_blk_size, &census); } ===================================== rts/sm/NonMovingCensus.h ===================================== @@ -20,10 +20,10 @@ struct NonmovingAllocCensus { struct NonmovingAllocCensus -nonmovingAllocatorCensusWithWords(struct NonmovingAllocator *alloc); +nonmovingAllocatorCensusWithWords(uint32_t alloc_idx); struct NonmovingAllocCensus -nonmovingAllocatorCensus(struct NonmovingAllocator *alloc); +nonmovingAllocatorCensus(uint32_t alloc_idx); void nonmovingPrintAllocatorCensus(bool collect_live_words); void nonmovingTraceAllocatorCensus(void); ===================================== rts/sm/NonMovingMark.c ===================================== @@ -27,6 +27,10 @@ #include "sm/Storage.h" #include "CNF.h" +#if defined(THREADED_RTS) +static void nonmovingResetUpdRemSetQueue (MarkQueue *rset); +static void nonmovingResetUpdRemSet (UpdRemSet *rset); +#endif static bool check_in_nonmoving_heap(StgClosure *p); static void mark_closure (MarkQueue *queue, const StgClosure *p, StgClosure **origin); static void trace_tso (MarkQueue *queue, StgTSO *tso); @@ -35,6 +39,9 @@ static void trace_PAP_payload (MarkQueue *queue, StgClosure *fun, StgClosure **payload, StgWord size); +#if defined(DEBUG) +static bool is_nonmoving_weak(StgWeak *weak); +#endif // How many Array# entries to add to the mark queue at once? #define MARK_ARRAY_CHUNK_LENGTH 128 @@ -250,7 +257,7 @@ StgWord nonmoving_write_barrier_enabled = false; MarkQueue *current_mark_queue = NULL; /* Initialise update remembered set data structures */ -void nonmovingMarkInitUpdRemSet() { +void nonmovingMarkInit() { #if defined(THREADED_RTS) initMutex(&upd_rem_set_lock); initCondition(&upd_rem_set_flushed_cond); @@ -263,33 +270,57 @@ static uint32_t markQueueLength(MarkQueue *q); #endif static void init_mark_queue_(MarkQueue *queue); -/* Transfers the given capability's update-remembered set to the global - * remembered set. - * - * Really the argument type should be UpdRemSet* but this would be rather - * inconvenient without polymorphism. - */ -void nonmovingAddUpdRemSetBlocks(MarkQueue *rset) +static void nonmovingAddUpdRemSetBlocks_(MarkQueue *rset) { - if (markQueueIsEmpty(rset)) return; - - // find the tail of the queue + // find the tail of the remembered set mark queue bdescr *start = rset->blocks; bdescr *end = start; while (end->link != NULL) end = end->link; + rset->blocks = NULL; // add the blocks to the global remembered set ACQUIRE_LOCK(&upd_rem_set_lock); end->link = upd_rem_set_block_list; upd_rem_set_block_list = start; RELEASE_LOCK(&upd_rem_set_lock); +} + +/* + * Transfers the given capability's update-remembered set to the global + * remembered set. + * + * Really the argument type should be UpdRemSet* but this would be rather + * inconvenient without polymorphism. + */ +static void nonmovingAddUpdRemSetBlocks_lock(MarkQueue *rset) +{ + if (markQueueIsEmpty(rset)) return; - // Reset remembered set + nonmovingAddUpdRemSetBlocks_(rset); + // Reset the state of the remembered set. ACQUIRE_SM_LOCK; init_mark_queue_(rset); - rset->is_upd_rem_set = true; RELEASE_SM_LOCK; + rset->is_upd_rem_set = true; +} + +/* + * Transfers the given capability's update-remembered set to the global + * remembered set. + * + * Really the argument type should be UpdRemSet* but this would be rather + * inconvenient without polymorphism. + * + * Caller must hold SM_LOCK. + */ +void nonmovingAddUpdRemSetBlocks(UpdRemSet *rset) +{ + if (markQueueIsEmpty(&rset->queue)) return; + + nonmovingAddUpdRemSetBlocks_(&rset->queue); + init_mark_queue_(&rset->queue); + rset->queue.is_upd_rem_set = true; } #if defined(THREADED_RTS) @@ -303,7 +334,7 @@ void nonmovingFlushCapUpdRemSetBlocks(Capability *cap) "Capability %d flushing update remembered set: %d", cap->no, markQueueLength(&cap->upd_rem_set.queue)); traceConcUpdRemSetFlush(cap); - nonmovingAddUpdRemSetBlocks(&cap->upd_rem_set.queue); + nonmovingAddUpdRemSetBlocks_lock(&cap->upd_rem_set.queue); atomic_inc(&upd_rem_set_flush_count, 1); signalCondition(&upd_rem_set_flushed_cond); // After this mutation will remain suspended until nonmovingFinishFlush @@ -401,7 +432,7 @@ void nonmovingFinishFlush(Task *task) { // See Note [Unintentional marking in resurrectThreads] for (uint32_t i = 0; i < getNumCapabilities(); i++) { - reset_upd_rem_set(&capabilities[i]->upd_rem_set); + nonmovingResetUpdRemSet(&capabilities[i]->upd_rem_set); } // Also reset upd_rem_set_block_list in case some of the UpdRemSets were // filled and we flushed them. @@ -426,7 +457,8 @@ push (MarkQueue *q, const MarkQueueEnt *ent) if (q->top->head == MARK_QUEUE_BLOCK_ENTRIES) { // Yes, this block is full. if (q->is_upd_rem_set) { - nonmovingAddUpdRemSetBlocks(q); + // Flush the block to the global update remembered set + nonmovingAddUpdRemSetBlocks_lock(q); } else { // allocate a fresh block. ACQUIRE_SM_LOCK; @@ -623,6 +655,16 @@ void updateRemembSetPushThunkEager(Capability *cap, } break; } + case THUNK_SELECTOR: + { + StgSelector *sel = (StgSelector *) thunk; + if (check_in_nonmoving_heap(sel->selectee)) { + // Don't bother to push origin; it makes the barrier needlessly + // expensive with little benefit. + push_closure(queue, sel->selectee, NULL); + } + break; + } case AP: { StgAP *ap = (StgAP *) thunk; @@ -632,9 +674,11 @@ void updateRemembSetPushThunkEager(Capability *cap, trace_PAP_payload(queue, ap->fun, ap->payload, ap->n_args); break; } - case THUNK_SELECTOR: + // We may end up here if a thunk update races with another update. + // In this case there is nothing to do as the other thread will have + // already pushed the updated thunk's free variables to the update + // remembered set. case BLACKHOLE: - // TODO: This is right, right? break; // The selector optimization performed by the nonmoving mark may have // overwritten a thunk which we are updating with an indirection. @@ -770,7 +814,7 @@ void markQueuePushClosure (MarkQueue *q, /* TODO: Do we really never want to specify the origin here? */ void markQueueAddRoot (MarkQueue* q, StgClosure** root) { - markQueuePushClosure(q, *root, NULL); + markQueuePushClosureGC(q, *root); } /* Push a closure to the mark queue without origin information */ @@ -881,6 +925,7 @@ static MarkQueueEnt markQueuePop (MarkQueue *q) static void init_mark_queue_ (MarkQueue *queue) { bdescr *bd = allocGroup(MARK_QUEUE_BLOCKS); + ASSERT(queue->blocks == NULL); queue->blocks = bd; queue->top = (MarkQueueBlock *) bd->start; queue->top->head = 0; @@ -898,19 +943,27 @@ void initMarkQueue (MarkQueue *queue) } /* Must hold sm_mutex. */ -void init_upd_rem_set (UpdRemSet *rset) +void nonmovingInitUpdRemSet (UpdRemSet *rset) { init_mark_queue_(&rset->queue); rset->queue.is_upd_rem_set = true; } -void reset_upd_rem_set (UpdRemSet *rset) +#if defined(THREADED_RTS) +static void nonmovingResetUpdRemSetQueue (MarkQueue *rset) { // UpdRemSets always have one block for the mark queue. This assertion is to // update this code if we change that. - ASSERT(rset->queue.blocks->link == NULL); - rset->queue.top->head = 0; + ASSERT(rset->is_upd_rem_set); + ASSERT(rset->blocks->link == NULL); + rset->top->head = 0; +} + +static void nonmovingResetUpdRemSet (UpdRemSet *rset) +{ + nonmovingResetUpdRemSetQueue(&rset->queue); } +#endif void freeMarkQueue (MarkQueue *queue) { @@ -1257,8 +1310,11 @@ mark_closure (MarkQueue *queue, const StgClosure *p0, StgClosure **origin) goto done; case WHITEHOLE: - while (*(StgInfoTable* volatile*) &p->header.info == &stg_WHITEHOLE_info); - // busy_wait_nop(); // FIXME + while (*(StgInfoTable* volatile*) &p->header.info == &stg_WHITEHOLE_info) +#if defined(PARALLEL_GC) + busy_wait_nop() +#endif + ; goto try_again; default: @@ -1466,10 +1522,12 @@ mark_closure (MarkQueue *queue, const StgClosure *p0, StgClosure **origin) break; } + case WEAK: + ASSERT(is_nonmoving_weak((StgWeak*) p)); + // fallthrough gen_obj: case CONSTR: case CONSTR_NOCAF: - case WEAK: case PRIM: { for (StgWord i = 0; i < info->layout.payload.ptrs; i++) { @@ -1522,8 +1580,15 @@ mark_closure (MarkQueue *queue, const StgClosure *p0, StgClosure **origin) } case THUNK_SELECTOR: - nonmoving_eval_thunk_selector(queue, (StgSelector*)p, origin); + { + StgSelector *sel = (StgSelector *) p; + // We may be able to evaluate this selector which may render the + // selectee unreachable. However, we must mark the selectee regardless + // to satisfy the snapshot invariant. + PUSH_FIELD(sel, selectee); + nonmoving_eval_thunk_selector(queue, sel, origin); break; + } case AP_STACK: { StgAP_STACK *ap = (StgAP_STACK *)p; @@ -1673,15 +1738,23 @@ done: * b. the nursery has been fully evacuated into the non-moving generation. * c. the mark queue has been seeded with a set of roots. * + * If budget is not UNLIMITED_MARK_BUDGET, then we will mark no more than the + * indicated number of objects and deduct the work done from the budget. */ GNUC_ATTR_HOT void -nonmovingMark (MarkQueue *queue) +nonmovingMark (MarkBudget* budget, MarkQueue *queue) { traceConcMarkBegin(); debugTrace(DEBUG_nonmoving_gc, "Starting mark pass"); - unsigned int count = 0; + uint64_t count = 0; while (true) { count++; + if (*budget == 0) { + return; + } else if (*budget != UNLIMITED_MARK_BUDGET) { + *budget -= 1; + } + MarkQueueEnt ent = markQueuePop(queue); switch (nonmovingMarkQueueEntryType(&ent)) { @@ -1810,19 +1883,65 @@ static bool nonmovingIsNowAlive (StgClosure *p) bdescr *bd = Bdescr((P_)p); - // All non-static objects in the non-moving heap should be marked as - // BF_NONMOVING - ASSERT(bd->flags & BF_NONMOVING); + const uint16_t flags = bd->flags; + if (flags & BF_LARGE) { + if (flags & BF_PINNED && !(flags & BF_NONMOVING)) { + // In this case we have a pinned object living in a non-full + // accumulator block which was not promoted to the nonmoving + // generation. Assume that the object is alive. + // See #22014. + return true; + } - if (bd->flags & BF_LARGE) { + ASSERT(bd->flags & BF_NONMOVING); return (bd->flags & BF_NONMOVING_SWEEPING) == 0 // the large object wasn't in the snapshot and therefore wasn't marked || (bd->flags & BF_MARKED) != 0; // The object was marked } else { - return nonmovingClosureMarkedThisCycle((P_)p); + // All non-static objects in the non-moving heap should be marked as + // BF_NONMOVING. + ASSERT(bd->flags & BF_NONMOVING); + + struct NonmovingSegment *seg = nonmovingGetSegment((StgPtr) p); + StgClosure *snapshot_loc = + (StgClosure *) nonmovingSegmentGetBlock(seg, nonmovingSegmentInfo(seg)->next_free_snap); + if (p >= snapshot_loc && nonmovingGetClosureMark((StgPtr) p) == 0) { + /* + * In this case we are looking at a block that wasn't allocated + * at the time that the snapshot was taken. As we do not mark such + * blocks, we must assume that it is reachable. + */ + return true; + } else { + return nonmovingClosureMarkedThisCycle((P_)p); + } + } +} + +// Mark all Weak#s on nonmoving_old_weak_ptr_list. +void nonmovingMarkWeakPtrList (struct MarkQueue_ *queue) +{ + ASSERT(nonmoving_weak_ptr_list == NULL); + for (StgWeak *w = nonmoving_old_weak_ptr_list; w != NULL; w = w->link) { + mark_closure(queue, (StgClosure *) w, NULL); + } +} + +// Determine whether a weak pointer object is on one of the nonmoving +// collector's weak pointer lists. Used for sanity checking. +#if defined(DEBUG) +static bool is_nonmoving_weak(StgWeak *weak) +{ + for (StgWeak *w = nonmoving_old_weak_ptr_list; w != NULL; w = w->link) { + if (w == weak) return true; + } + for (StgWeak *w = nonmoving_weak_ptr_list; w != NULL; w = w->link) { + if (w == weak) return true; } + return false; } +#endif // Non-moving heap variant of `tidyWeakList` bool nonmovingTidyWeaks (struct MarkQueue_ *queue) @@ -1832,6 +1951,9 @@ bool nonmovingTidyWeaks (struct MarkQueue_ *queue) StgWeak **last_w = &nonmoving_old_weak_ptr_list; StgWeak *next_w; for (StgWeak *w = nonmoving_old_weak_ptr_list; w != NULL; w = next_w) { + // This should have been marked by nonmovingMarkWeaks + ASSERT(nonmovingIsNowAlive((StgClosure *) w)); + if (w->header.info == &stg_DEAD_WEAK_info) { // finalizeWeak# was called on the weak next_w = w->link; @@ -1842,7 +1964,10 @@ bool nonmovingTidyWeaks (struct MarkQueue_ *queue) // Otherwise it's a live weak ASSERT(w->header.info == &stg_WEAK_info); - if (nonmovingIsNowAlive(w->key)) { + // See Note [Weak pointer processing and the non-moving GC] in + // MarkWeak.c + bool key_in_nonmoving = Bdescr((StgPtr) w->key)->flags & BF_NONMOVING; + if (!key_in_nonmoving || nonmovingIsNowAlive(w->key)) { nonmovingMarkLiveWeak(queue, w); did_work = true; @@ -1850,7 +1975,7 @@ bool nonmovingTidyWeaks (struct MarkQueue_ *queue) *last_w = w->link; next_w = w->link; - // and put it on the weak ptr list + // and put it on nonmoving_weak_ptr_list w->link = nonmoving_weak_ptr_list; nonmoving_weak_ptr_list = w; } else { @@ -1872,7 +1997,8 @@ void nonmovingMarkDeadWeak (struct MarkQueue_ *queue, StgWeak *w) void nonmovingMarkLiveWeak (struct MarkQueue_ *queue, StgWeak *w) { - ASSERT(nonmovingClosureMarkedThisCycle((P_)w)); + ASSERT(nonmovingIsNowAlive((StgClosure *) w)); + ASSERT(nonmovingIsNowAlive((StgClosure *) w->key)); markQueuePushClosure_(queue, w->value); markQueuePushClosure_(queue, w->finalizer); markQueuePushClosure_(queue, w->cfinalizers); @@ -1886,9 +2012,9 @@ void nonmovingMarkDeadWeaks (struct MarkQueue_ *queue, StgWeak **dead_weaks) { StgWeak *next_w; for (StgWeak *w = nonmoving_old_weak_ptr_list; w; w = next_w) { - ASSERT(!nonmovingClosureMarkedThisCycle((P_)(w->key))); + ASSERT(!nonmovingIsNowAlive(w->key)); nonmovingMarkDeadWeak(queue, w); - next_w = w ->link; + next_w = w->link; w->link = *dead_weaks; *dead_weaks = w; } ===================================== rts/sm/NonMovingMark.h ===================================== @@ -111,6 +111,11 @@ typedef struct { MarkQueue queue; } UpdRemSet; +// How much marking work we are allowed to perform +// See Note [Sync phase marking budget] in NonMoving.c +typedef int64_t MarkBudget; +#define UNLIMITED_MARK_BUDGET INT64_MIN + // Number of blocks to allocate for a mark queue #define MARK_QUEUE_BLOCKS 16 @@ -135,10 +140,9 @@ extern MarkQueue *current_mark_queue; extern bdescr *upd_rem_set_block_list; -void nonmovingMarkInitUpdRemSet(void); +void nonmovingMarkInit(void); -void init_upd_rem_set(UpdRemSet *rset); -void reset_upd_rem_set(UpdRemSet *rset); +void nonmovingInitUpdRemSet(UpdRemSet *rset); void updateRemembSetPushClosure(Capability *cap, StgClosure *p); void updateRemembSetPushThunk(Capability *cap, StgThunk *p); void updateRemembSetPushTSO(Capability *cap, StgTSO *tso); @@ -155,8 +159,13 @@ void markQueueAddRoot(MarkQueue* q, StgClosure** root); void initMarkQueue(MarkQueue *queue); void freeMarkQueue(MarkQueue *queue); -void nonmovingMark(struct MarkQueue_ *restrict queue); +void nonmovingMark(MarkBudget *budget, struct MarkQueue_ *restrict queue); +INLINE_HEADER void nonmovingMarkUnlimitedBudget(struct MarkQueue_ *restrict queue) { + MarkBudget budget = UNLIMITED_MARK_BUDGET; + nonmovingMark(&budget, queue); +} +void nonmovingMarkWeakPtrList(struct MarkQueue_ *queue); bool nonmovingTidyWeaks(struct MarkQueue_ *queue); void nonmovingTidyThreads(void); void nonmovingMarkDeadWeaks(struct MarkQueue_ *queue, StgWeak **dead_weak_ptr_list); @@ -164,7 +173,7 @@ void nonmovingResurrectThreads(struct MarkQueue_ *queue, StgTSO **resurrected_th bool nonmovingIsAlive(StgClosure *p); void nonmovingMarkDeadWeak(struct MarkQueue_ *queue, StgWeak *w); void nonmovingMarkLiveWeak(struct MarkQueue_ *queue, StgWeak *w); -void nonmovingAddUpdRemSetBlocks(struct MarkQueue_ *rset); +void nonmovingAddUpdRemSetBlocks(UpdRemSet *rset); void markQueuePush(MarkQueue *q, const MarkQueueEnt *ent); void markQueuePushClosureGC(MarkQueue *q, StgClosure *p); ===================================== rts/sm/Sanity.c ===================================== @@ -619,11 +619,12 @@ static void checkNonmovingSegments (struct NonmovingSegment *seg) void checkNonmovingHeap (const struct NonmovingHeap *heap) { for (unsigned int i=0; i < NONMOVING_ALLOCA_CNT; i++) { - const struct NonmovingAllocator *alloc = heap->allocators[i]; + const struct NonmovingAllocator *alloc = &heap->allocators[i]; checkNonmovingSegments(alloc->filled); checkNonmovingSegments(alloc->active); - for (unsigned int cap=0; cap < getNumCapabilities(); cap++) { - checkNonmovingSegments(alloc->current[cap]); + for (unsigned int cap_n=0; cap_n < getNumCapabilities(); cap_n++) { + Capability *cap = capabilities[cap_n]; + checkNonmovingSegments(cap->current_segments[i]); } } } @@ -1047,11 +1048,12 @@ findMemoryLeak (void) markBlocks(nonmoving_compact_objects); markBlocks(nonmoving_marked_compact_objects); for (i = 0; i < NONMOVING_ALLOCA_CNT; i++) { - struct NonmovingAllocator *alloc = nonmovingHeap.allocators[i]; + struct NonmovingAllocator *alloc = &nonmovingHeap.allocators[i]; markNonMovingSegments(alloc->filled); markNonMovingSegments(alloc->active); for (j = 0; j < getNumCapabilities(); j++) { - markNonMovingSegments(alloc->current[j]); + Capability *cap = capabilities[j]; + markNonMovingSegments(cap->current_segments[i]); } } markNonMovingSegments(nonmovingHeap.sweep_list); @@ -1156,23 +1158,18 @@ countNonMovingSegments(struct NonmovingSegment *segs) return ret; } -static W_ -countNonMovingAllocator(struct NonmovingAllocator *alloc) -{ - W_ ret = countNonMovingSegments(alloc->filled) - + countNonMovingSegments(alloc->active); - for (uint32_t i = 0; i < getNumCapabilities(); ++i) { - ret += countNonMovingSegments(alloc->current[i]); - } - return ret; -} - static W_ countNonMovingHeap(struct NonmovingHeap *heap) { W_ ret = 0; for (int alloc_idx = 0; alloc_idx < NONMOVING_ALLOCA_CNT; alloc_idx++) { - ret += countNonMovingAllocator(heap->allocators[alloc_idx]); + struct NonmovingAllocator *alloc = &heap->allocators[alloc_idx]; + ret += countNonMovingSegments(alloc->filled); + ret += countNonMovingSegments(alloc->active); + for (uint32_t c = 0; c < getNumCapabilities(); ++c) { + Capability *cap = capabilities[c]; + ret += countNonMovingSegments(cap->current_segments[alloc_idx]); + } } ret += countNonMovingSegments(heap->sweep_list); ret += countNonMovingSegments(heap->free); ===================================== rts/sm/Storage.c ===================================== @@ -214,17 +214,14 @@ initStorage (void) } oldest_gen->to = oldest_gen; - // Nonmoving heap uses oldest_gen so initialize it after initializing oldest_gen - nonmovingInit(); - #if defined(THREADED_RTS) // nonmovingAddCapabilities allocates segments, which requires taking the gc // sync lock, so initialize it before nonmovingAddCapabilities initSpinLock(&gc_alloc_block_sync); #endif - if (RtsFlags.GcFlags.useNonmoving) - nonmovingAddCapabilities(getNumCapabilities()); + // Nonmoving heap uses oldest_gen so initialize it after initializing oldest_gen + nonmovingInit(); /* The oldest generation has one step. */ if (RtsFlags.GcFlags.compact || RtsFlags.GcFlags.sweep) { @@ -320,11 +317,10 @@ void storageAddCapabilities (uint32_t from, uint32_t to) } } - // Initialize NonmovingAllocators and UpdRemSets + // Initialize non-moving collector if (RtsFlags.GcFlags.useNonmoving) { - nonmovingAddCapabilities(to); - for (i = 0; i < to; ++i) { - init_upd_rem_set(&capabilities[i]->upd_rem_set); + for (i = from; i < to; i++) { + nonmovingInitCapability(capabilities[i]); } } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b623eaf3a3c9deb28984618088e3192ad30d6414...65690ab8dbfb83740db2c7f9d2f9a01f4d7e82e5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b623eaf3a3c9deb28984618088e3192ad30d6414...65690ab8dbfb83740db2c7f9d2f9a01f4d7e82e5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 00:37:33 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 07 Feb 2023 19:37:33 -0500 Subject: [Git][ghc/ghc][wip/backports-9.6] 72 commits: ci: Change owner of files in test-bootstrap job Message-ID: <63e2eecda0e61_1108fe7d7850c81890719@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.6 at Glasgow Haskell Compiler / GHC Commits: 51343814 by Matthew Pickering at 2023-01-27T08:15:12+00:00 ci: Change owner of files in test-bootstrap job (cherry picked from commit 00981dc9d5f81f355c3a6276a75c93b87a0a1e6a) - - - - - 9a91e662 by Matthew Pickering at 2023-01-27T08:15:12+00:00 rel_eng: Add release engineering scripts into ghc tree It is better to keep these scripts in the tree as they depend on the CI configuration and so on. By keeping them in tree we can keep them up-to-date as the CI config changes and also makes it easier to backport changes to the release script between release branches in future. The final motivation is that it makes generating GHCUp metadata possible. (cherry picked from commit c41aeb303b4e0edbe6acc6476a518958f2656b74) - - - - - b8392e1f by Matthew Pickering at 2023-01-27T08:15:12+00:00 ci: Don't use complicated image or clone in not-interruptible job This job exists only for the meta-reason of not allowing nightly pipelines to be cancelled. It was taking two minutes to run as in order to run "true" we would also clone the whole GHC repo. (cherry picked from commit e9cfc723f3225c56a0acd5eb4288be321fd58070) - - - - - 78a84385 by Matthew Pickering at 2023-01-27T08:16:54+00:00 Add scripts to generate ghcup metadata on nightly and release pipelines 1. A python script in .gitlab/rel_eng/mk-ghcup-metadata which generates suitable metadata for consumption by GHCUp for the relevant pipelines. - The script generates the metadata just as the ghcup maintainers want, without taking into account platform/library combinations. It is updated manually when the mapping changes. - The script downloads the bindists which ghcup wants to distribute, calculates the hash and generates the yaml in the correct structure. - The script is documented in the .gitlab/rel_eng/mk-ghcup-metadata/README.mk file 1a. The script requires us to understand the mapping from platform -> job. To choose the preferred bindist for each platform the .gitlab/gen_ci.hs script is modified to allow outputting a metadata file which answers the question about which job produces the bindist which we want to distribute to users for a specific platform. 2. Pipelines to run on nightly and release jobs to generate metadata - ghcup-metadata-nightly: Generates metadata which points directly to artifacts in the nightly job. - ghcup-metadata-release: Generates metadata suitable for inclusion directly in ghcup by pointing to the downloads folder where the bindist will be uploaded to. 2a. Trigger jobs which test the generated metadata in the downstream `ghccup-ci` repo. See that repo for documentation about what is tested and how but essentially we test in a variety of clean images that ghcup can download and install the bindists we say exist in our metadata. (cherry picked from commit ef4ffd9d696ff239c16894d4a958e052da7b009e) - - - - - f8828f2c by Matthew Pickering at 2023-01-27T08:16:55+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 (cherry picked from commit 0a022207a3204c8952a2564ed88c83f748e8cac1) - - - - - d6cdf22c by Matthew Pickering at 2023-01-27T08:16:55+00:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. (cherry picked from commit 2e3dbafa57013b250c92b031ce50962d4f5e13a3) - - - - - b19c8231 by Matthew Pickering at 2023-01-27T08:16:55+00:00 Store dehydrated data structures in CgModBreaks This fixes a tricky leak in GHCi where we were retaining old copies of HscEnvs when reloading. If not all modules were recompiled then these hydrated fields in break points would retain a reference to the old HscEnv which could double memory usage. Fixes #22530 (cherry picked from commit 1262d3f8c03799a04d3c5fcf33d4d4db715ca9a1) - - - - - e69e7e00 by Matthew Pickering at 2023-01-27T08:16:55+00:00 Force more in NFData Name instance Doesn't force the lazy `OccName` field (#19619) which is already known as a really bad source of leaks. When we slam the hammer storing Names on disk (in interface files or the like), all this should be forced as otherwise a `Name` can easily retain an `Id` and hence the entire world. Fixes #22833 (cherry picked from commit e27eb80cc7e0c82e07fbd8d9ae8112d9070c4355) - - - - - c38610e4 by Matthew Pickering at 2023-01-27T08:16:55+00:00 Force OccName in tidyTopName This occname has just been derived from an `Id`, so need to force it promptly so we can release the Id back to the world. Another symptom of the bug caused by #19619 (cherry picked from commit 3d004d5a961fbbbe11da1050b725468a970bee4b) - - - - - 2817ae28 by Matthew Pickering at 2023-01-27T08:16:55+00:00 Strict fields in ModNodeKey (otherwise retains HomeModInfo) Towards #22530 (cherry picked from commit f2a0fea09a88693d876fb891ea7c8c97373c4aa6) - - - - - d8d1d1c7 by Alexis King at 2023-01-27T08:16:55+00:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. (cherry picked from commit 476d98d4fcccb54a37ec2d9c0fed79696237c166) - - - - - f1211618 by Simon Peyton Jones at 2023-01-27T08:16:55+00: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. (cherry picked from commit 13a0566b58ecc295883b11f20045b4214d8acd72) - - - - - e2342747 by Ben Gamari at 2023-01-27T08:16:55+00:00 base: Make changelog proposal references more consistent Addresses #22773. (cherry picked from commit f410d70a5543240015d7404ff529bdcaaec8d675) - - - - - ef21780f by Sylvain Henry at 2023-01-27T08:16:55+00: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. (cherry picked from commit e987e345c807035e4637ca3eae227ae501e16c42) - - - - - 7d86db2b by Sylvain Henry at 2023-01-27T08:16:55+00:00 Hadrian: fix Windows cross-compilation Decision to build either unix or Win32 package must be stage specific for cross-compilation to be supported. (cherry picked from commit 48131ee2d8ba7074a4c2763a32c12df105305a75) - - - - - e0d9ef66 by Sylvain Henry at 2023-01-27T08:16:55+00:00 Fix RTS build on Windows This change fixes a cross-compilation issue from ArchLinux to Windows because these symbols weren't found. (cherry picked from commit 288fa0179a2f54e4594afe184eac71cc85c46643) - - - - - 826a3112 by Sylvain Henry at 2023-01-27T08:16:55+00:00 configure: support "windows" as an OS (cherry picked from commit 2fdf22aebda2307d86872c792633d1856d666c9b) - - - - - b6ffad2a by Matthew Pickering at 2023-01-27T08:16:55+00:00 ghcup metadata: Fix subdir for windows bindist (cherry picked from commit 159426acb90f7db394ec40dfe22d4999a9190e6e) - - - - - bee2a616 by Matthew Pickering at 2023-01-27T08:16:55+00:00 ghcup metadata: Remove viPostRemove field from generated metadata This has been removed from the downstream metadata. (cherry picked from commit 7915f039a37f6496ec572f33ddb204a5709f7020) - - - - - 601938b5 by Andrei Borzenkov at 2023-01-27T08:16:55+00:00 Fix printing of promoted MkSolo datacon (#22785) Problem: In 2463df2f, the Solo data constructor was renamed to MkSolo, and Solo was turned into a pattern synonym for backwards compatibility. Since pattern synonyms can not be promoted, the old code that pretty-printed promoted single-element tuples started producing ill-typed code: t :: Proxy ('Solo Int) This fails with "Pattern synonym ‘Solo’ used as a type" The solution is to track the distinction between type constructors and data constructors more carefully when printing single-element tuples. (cherry picked from commit 14b5982a3aea351e4b01c5804ebd4d4629ba6bab) - - - - - 3e6ca4d1 by Vladislav Zavialov at 2023-01-27T08:16:55+00:00 Enable -Wstar-is-type by default (#22759) Following the plan in GHC Proposal #143 "Remove the * kind syntax", which states: In the next release (or 3 years in), enable -fwarn-star-is-type by default. The "next release" happens to be 9.6.1 I also moved the T21583 test case from should_fail to should_compile, because the only reason it was failing was -Werror=compat in our test suite configuration. (cherry picked from commit e9c0537cfbf7b47c64f592f529e402358b66ca7f) - - - - - 6d788b11 by Matthew Pickering at 2023-01-27T08:44:42+00:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - 9c263aff by Matthew Pickering at 2023-01-27T08:46:57+00:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 0751f56a by Matthew Pickering at 2023-01-27T08:47:41+00:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - e740dd68 by Ben Gamari at 2023-01-27T10:47:19-05:00 upload_ghc_libs: Don't handle `--skip` in `prepare` mode - - - - - 19a68c78 by Matthew Pickering at 2023-01-28T10:17:37+00:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - f9b50be4 by Andreas Klebinger at 2023-02-01T10:24:41+00:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- (cherry picked from commit 08ba87200ff068aa37cac082e61ee7e2d534daf5) - - - - - 4ed5ea30 by Richard Eisenberg at 2023-02-01T10:43:36+00:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. (cherry picked from commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90) - - - - - 31b63c46 by Alan Zimmerman at 2023-02-01T10:48:59+00:00 EPA: exact print HsDocTy To match ghc-exactprint https://github.com/alanz/ghc-exactprint/pull/121 (cherry picked from commit 965a273510adfac4f041a31182c2fec82e614e47) - - - - - f19eb3ac by Alan Zimmerman at 2023-02-01T10:51:36+00:00 EPA: Add annotation for 'type' in DataDecl Closes #22765 (cherry picked from commit 97ac8230b0a645aae27b7ee42aa55b0c84735684) - - - - - 686350e9 by Alan Zimmerman at 2023-02-01T13:18:46+00:00 EPA: Add SourceText to HsOverLabel To be able to capture string literals with possible escape codes as labels. Close #22771 (cherry picked from commit fec7c2ea8242773b53b253d9536426f743443944) - - - - - 9cdab037 by Ben Gamari at 2023-02-01T13:18:46+00:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 (cherry picked from commit e480fbc2c6fdcb252847fc537ab7ec50d1dc2dfd) - - - - - be39064e by Ben Gamari at 2023-02-01T13:18:46+00:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. (cherry picked from commit 56c1bd986ac13e3a1fe1149f011480e44f857f5a) - - - - - 80a6bb73 by nineonine at 2023-02-01T13:18:46+00:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. (cherry picked from commit b3a3534b6f75b34dc4db76e904e071485da6d5cc) - - - - - 3c21d69d by Ben Gamari at 2023-02-01T13:18:46+00:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. (cherry picked from commit be417a47c7695998dea0adc05489a7b8838a78b6) - - - - - ac6c24f7 by Ben Gamari at 2023-02-01T13:18:46+00:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. (cherry picked from commit 30989d137b8f3a8fddbfd116e04b48f23c24f86c) - - - - - 6c212ccc by Ben Gamari at 2023-02-01T13:18:46+00:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. (cherry picked from commit 7566fd9de38c67360c090f828923d41587af519c) - - - - - 79241b6d by Ben Gamari at 2023-02-01T13:18:46+00:00 testsuite: Add regression test for #22798 (cherry picked from commit 2cb500a5ee1a31dfe1a2cdd71f175442026eb082) - - - - - d9e8c39d by Simon Peyton Jones at 2023-02-01T13:18:46+00:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 (cherry picked from commit 638277ba7bd2683f539afb0bf469fe75376994e2) - - - - - 86dc9a79 by Zubin Duggal at 2023-02-01T13:18:46+00:00 bindist configure: Fail if find not found (#22691) (cherry picked from commit c9967d137cff83c7688e26f87a8b5e196a75ec93) - - - - - 86d88743 by Oleg Grenrus at 2023-02-01T13:18:47+00:00 Add Foldable1 Solo instance (cherry picked from commit 082b7d43ee4b8203dc9bca53e5e1f7a45c42eeb8) - - - - - 2eb49ea6 by Krzysztof Gogolewski at 2023-02-01T13:18:47+00:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 (cherry picked from commit f83374f8649e5d8413e7ed585b0e058690c38563) - - - - - 632937bb by Ryan Scott at 2023-02-01T13:18:47+00:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. (cherry picked from commit 20598ef6d9e26e2e0af9ac42a42e7be00d7cc4f3) - - - - - 2efb886c by Ryan Scott at 2023-02-01T13:18:47+00:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. (cherry picked from commit 2f1450521b816a7d287b72deba14d59b6ccfbdbf) - - - - - fc117e3d by Ben Gamari at 2023-02-01T13:18:47+00:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. (cherry picked from commit a2d814dc84dbdcdb6c1e274b8bd7c212cc98c39e) - - - - - 6e1498fa by Ben Gamari at 2023-02-01T13:18:47+00:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. (cherry picked from commit f838815c365773a8107bf035a8ec27b8ff6ecc8b) - - - - - 1f42664c by Ben Gamari at 2023-02-01T13:18:47+00:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. (cherry picked from commit 2e48c19a7faf975318e954faea26f37deb763ac0) - - - - - 653c7513 by Ben Gamari at 2023-02-01T13:18:47+00:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. (cherry picked from commit 93f0e3c49cea484bd6e838892ff8702ec51f34c3) - - - - - 3ac79844 by Simon Peyton Jones at 2023-02-01T13:18:47+00:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) (cherry picked from commit d0f34f25ceaae9ef0a21f15f811469d0bed9da69) - - - - - fb186399 by Bodigrim at 2023-02-01T13:18:47+00:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} (cherry picked from commit c9ad8852bdd083f8692361134bc247a1eb2bbd77) - - - - - fdfd8911 by Cheng Shao at 2023-02-01T13:18:47+00:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. (cherry picked from commit 7e11c6dc25cb9dd14ae33ee9715ddbc8ebf9836e) - - - - - adf17604 by Cheng Shao at 2023-02-01T13:18:47+00:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. (cherry picked from commit 6ea2aa0293aedea2f873b7b5d9cff5e7b9e2f188) - - - - - 329097fc by Matthew Pickering at 2023-02-01T13:18:47+00:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 (cherry picked from commit 7cbdaad0396cee561f125c95f3352cebabd8ed99) - - - - - 5695611e by Cheng Shao at 2023-02-01T13:18:47+00:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. (cherry picked from commit 78c07219d5dad9730bbe3ec26ad22912ff22f058) - - - - - c4cc32d9 by Cheng Shao at 2023-02-01T13:18:47+00:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. (cherry picked from commit da468391872f6be286db37a0f016a37f9f362509) - - - - - 8f29bdae by Cheng Shao at 2023-02-01T13:18:47+00:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. (cherry picked from commit fd8f32bf551c34b95275ebb4fe648680013156f3) - - - - - 343c856f by Cheng Shao at 2023-02-01T13:18:47+00:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. (cherry picked from commit 7716cbe64862932fd69348b2594a14f2092e1c02) - - - - - e377aa49 by Ben Gamari at 2023-02-01T13:18:47+00:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. (cherry picked from commit 22089f693cf6e662a58a7011adb94d7f768ad2d7) - - - - - d91e6233 by Cheng Shao at 2023-02-01T13:18:47+00:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. (cherry picked from commit f0eefa3cf058879246991747dcd18c811402f9e5) - - - - - 30d3c827 by Ben Gamari at 2023-02-01T13:18:47+00:00 nativeGen/X86: MFENCE is unnecessary for release semantics In #22764 a user noticed that a program implementing a simple atomic counter via an STRef regressed significantly due to the introduction of necessary atomic operations in the MutVar# primops (#22468). This regression was caused by a bug in the NCG, which emitted an unnecessary MFENCE instruction for a release-ordered atomic write. MFENCE is rather only needed to achieve sequentially consistent ordering. Fixes #22764. (cherry picked from commit f058e3672b969f301b6b1637f8ab081654ec947a) - - - - - cbd60c81 by Matthew Pickering at 2023-02-07T19:27:16-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 (cherry picked from commit 0ada454703560b733fe3c920b87496ac1238c29e) - - - - - 18942043 by Bodigrim at 2023-02-07T19:27:23-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec (cherry picked from commit 3135819847aae0cdcc6c2fca4a2234fcfed1db93) - - - - - 86698692 by Andreas Klebinger at 2023-02-07T19:27:30-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. (cherry picked from commit bf3f88a1a5b23bdf304baca473c3ee797c5f86bd) - - - - - c6c96a3a by Ben Gamari at 2023-02-07T19:27:36-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) (cherry picked from commit 25537dfda4ae59bc0321b229ca9ff924ef64d1fa) - - - - - 51397a53 by Bodigrim at 2023-02-07T19:27:42-05:00 Fix colors in emacs terminal (cherry picked from commit 5a54ac0b2b915889950c83e04bf1beb08631891e) - - - - - 2c7f85fe by Ryan Scott at 2023-02-07T19:27:58-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` (cherry picked from commit de1d15127ac3f41ac3044215b0ea3398a36edc89) - - - - - 81873448 by Tamar Christina at 2023-02-07T19:27:59-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. (cherry picked from commit 48e391952c17ff7eab10b0b1456e3f2a2af28a9b) - - - - - 18d1c5f9 by Ben Gamari at 2023-02-07T19:29:38-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. (cherry picked from commit b2bb3e62275cc1d9e00a2d5ed511843192133ed5) - - - - - 2ec1c359 by Luite Stegeman at 2023-02-07T19:29:54-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 (cherry picked from commit 77a8234c5d284846e18c0a44ba5ee196059aaea6) - - - - - 8ab4d956 by sheaf at 2023-02-07T19:30:16-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 (cherry picked from commit b17fb3d96bd2e9f3bf96392f3b3b3e0aed7fe276) - - - - - dce53f5c by Ben Gamari at 2023-02-07T19:30:22-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) (cherry picked from commit 929161943f19e1673288adc83d165ddc99865798) - - - - - bafa3899 by Sylvain Henry at 2023-02-07T19:37:15-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> (cherry picked from commit 6636b670233522f01d002c9b97827d00289dbf5c) - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - + .gitlab/generate_job_metadata - .gitlab/generate_jobs - .gitlab/jobs.yaml - + .gitlab/rel_eng/default.nix - + .gitlab/rel_eng/fetch-gitlab-artifacts/.gitignore - + .gitlab/rel_eng/fetch-gitlab-artifacts/README.mkd - + .gitlab/rel_eng/fetch-gitlab-artifacts/default.nix - + .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - + .gitlab/rel_eng/fetch-gitlab-artifacts/setup.py - + .gitlab/rel_eng/mk-ghcup-metadata/.gitignore - + .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - + .gitlab/rel_eng/mk-ghcup-metadata/default.nix - + .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - + .gitlab/rel_eng/mk-ghcup-metadata/setup.py - + .gitlab/rel_eng/nix/sources.json - + .gitlab/rel_eng/nix/sources.nix - + .gitlab/rel_eng/upload.sh - .gitlab/upload_ghc_libs.py → .gitlab/rel_eng/upload_ghc_libs.py - cabal.project-reinstall - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bc2c7480ca1dd4abb72fa31b76e14d420337bfc0...bafa389975872e1dec6925e05ee0efc349656110 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bc2c7480ca1dd4abb72fa31b76e14d420337bfc0...bafa389975872e1dec6925e05ee0efc349656110 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 01:49:09 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Tue, 07 Feb 2023 20:49:09 -0500 Subject: [Git][ghc/ghc][wip/t21766] 13 commits: Don't allow . in overloaded labels Message-ID: <63e2ff958e8ef_730ce527103634c@gitlab.mail> Finley McIlwaine pushed to branch wip/t21766 at Glasgow Haskell Compiler / GHC Commits: b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - caf6c5fa by Finley McIlwaine at 2023-02-07T12:20:09-07:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - cbedbb40 by Finley McIlwaine at 2023-02-07T12:20:09-07:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - f02355f7 by Finley McIlwaine at 2023-02-07T12:20:09-07:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - 9984fb5c by Finley McIlwaine at 2023-02-07T12:20:09-07:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - db651fe1 by Finley McIlwaine at 2023-02-07T12:20:09-07:00 Add note describing IPE data compression See ticket #21766 - - - - - f501788b by Finley McIlwaine at 2023-02-07T12:20:09-07:00 Fix byte order of IPE data, fix IPE tests Make sure byte order of written IPE buffer entries matches target. Make sure the IPE-related tests properly access the fields of IPE buffer entry nodes with the new IPE layout. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. See ticket #21766. - - - - - e4f47dff by Finley McIlwaine at 2023-02-07T12:20:09-07:00 Fix IPE data decompression buffer allocation Capacity of buffers allocated for decompressed IPE data was incorrect due to a misuse of the `ZSTD_findFrameCompressedSize` function. Fix by always storing decompressed size of IPE data in IPE buffer list nodes and using `ZSTD_findFrameCompressedSize` to determine the size of the compressed data. See ticket #21766 - - - - - 90c04ab0 by Finley McIlwaine at 2023-02-07T12:20:09-07:00 Add optional dependencies to ./configure output Changes the configure script to indicate whether libnuma, libzstd, or libdw are being used as dependencies due to their optional features being enabled. - - - - - 2fc71ba8 by Finley McIlwaine at 2023-02-07T12:26:10-07:00 Add IPE-enabled builds to CI - Adds an IPE job to the CI pipeline which is triggered by the ~IPE label - Introduces CI logic to enable IPE data compression - Enables uncompressed IPE data on debug CI job - Regenerates jobs.yaml MR https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/112 on the images repository is meant to ensure that the proper images have libzstd-dev installed. - - - - - a240bf49 by Finley McIlwaine at 2023-02-07T18:45:45-07:00 Update user's guide and release notes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. See ticket #21766 - - - - - 29 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Core/TyCon.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/ghc.cabal.in - configure.ac - docs/users_guide/9.6.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debug-info.rst - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Packages.hs - libraries/base/GHC/Int.hs - libraries/base/GHC/Word.hs - m4/fp_find_libnuma.m4 - + m4/fp_find_libzstd.m4 - rts/IPE.c - rts/IPE.h - rts/include/rts/IPE.h - rts/rts.cabal.in - testsuite/tests/overloadedrecflds/should_run/T11671_run.hs - testsuite/tests/printer/Test22771.hs - testsuite/tests/rts/ipe/ipeEventLog_fromMap.c - testsuite/tests/rts/ipe/ipeMap.c - testsuite/tests/rts/ipe/ipe_lib.c - testsuite/tests/rts/ipe/ipe_lib.h Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -140,6 +140,8 @@ data BuildConfig , llvmBootstrap :: Bool , withAssertions :: Bool , withNuma :: Bool + , withZstd :: Bool + , withIpe :: Bool , crossTarget :: Maybe String , crossEmulator :: CrossEmulator , configureWrapper :: Maybe String @@ -152,10 +154,11 @@ data BuildConfig -- Extra arguments to pass to ./configure due to the BuildConfig configureArgsStr :: BuildConfig -> String configureArgsStr bc = unwords $ - ["--enable-unregisterised"| unregisterised bc ] + ["--enable-unregisterised"| unregisterised bc ] ++ ["--disable-tables-next-to-code" | not (tablesNextToCode bc) ] ++ ["--with-intree-gmp" | Just _ <- pure (crossTarget bc) ] ++ ["--with-system-libffi" | crossTarget bc == Just "wasm32-wasi" ] + ++ ["--enable-ipe-data-compression" | withZstd bc ] -- Compute the hadrian flavour from the BuildConfig mkJobFlavour :: BuildConfig -> Flavour @@ -165,11 +168,18 @@ mkJobFlavour BuildConfig{..} = Flavour buildFlavour opts [Dwarf | withDwarf] ++ [FullyStatic | fullyStatic] ++ [ThreadSanitiser | threadSanitiser] ++ - [NoSplitSections | noSplitSections, buildFlavour == Release ] + [NoSplitSections | noSplitSections, buildFlavour == Release ] ++ + [Ipe | withIpe] data Flavour = Flavour BaseFlavour [FlavourTrans] -data FlavourTrans = Llvm | Dwarf | FullyStatic | ThreadSanitiser | NoSplitSections +data FlavourTrans = + Llvm + | Dwarf + | FullyStatic + | ThreadSanitiser + | NoSplitSections + | Ipe data BaseFlavour = Release | Validate | SlowValidate deriving Eq @@ -187,6 +197,8 @@ vanilla = BuildConfig , llvmBootstrap = False , withAssertions = False , withNuma = False + , withZstd = False + , withIpe = False , crossTarget = Nothing , crossEmulator = NoEmulator , configureWrapper = Nothing @@ -216,8 +228,17 @@ debug = vanilla { buildFlavour = SlowValidate , withAssertions = True -- WithNuma so at least one job tests Numa , withNuma = True + + -- Build with IPE in debug so at least one job tests + -- uncompressed IPE data + , withIpe = True } +ipe :: BuildConfig +ipe = vanilla { withIpe = True + , withZstd = True + } + static :: BuildConfig static = vanilla { fullyStatic = True } @@ -306,17 +327,18 @@ testEnv arch opsys bc = intercalate "-" $ -- | The hadrian flavour string we are going to use for this build flavourString :: Flavour -> String -flavourString (Flavour base trans) = baseString base ++ concatMap (("+" ++) . flavourString) trans +flavourString (Flavour base trans) = base_string base ++ concatMap (("+" ++) . flavour_string) trans where - baseString Release = "release" - baseString Validate = "validate" - baseString SlowValidate = "slow-validate" + base_string Release = "release" + base_string Validate = "validate" + base_string SlowValidate = "slow-validate" - flavourString Llvm = "llvm" - flavourString Dwarf = "debug_info" - flavourString FullyStatic = "fully_static" - flavourString ThreadSanitiser = "thread_sanitizer" - flavourString NoSplitSections = "no_split_sections" + flavour_string Llvm = "llvm" + flavour_string Dwarf = "debug_info" + flavour_string FullyStatic = "fully_static" + flavour_string ThreadSanitiser = "thread_sanitizer" + flavour_string NoSplitSections = "no_split_sections" + flavour_string Ipe = "ipe" -- The path to the docker image (just for linux builders) dockerImage :: Arch -> Opsys -> Maybe String @@ -509,7 +531,7 @@ manualRule rules = rules { when = Manual } -- For example, even if you don't explicitly disable a rule it will end up in the -- rule list with the OFF state. enumRules :: OnOffRules -> [OnOffRule] -enumRules o = map lkup rules +enumRules o = map lkup rulesList where enabled_rules = rule_set o lkup r = OnOffRule (if S.member r enabled_rules then On else Off) r @@ -544,6 +566,7 @@ data Rule = FastCI -- ^ Run this job when the fast-ci label is set | Nightly -- ^ Only run this job in the nightly pipeline | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. + | IpeData -- ^ Only run this job when the "IPE" label is set | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) @@ -568,12 +591,14 @@ ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" ruleString Off Nightly = "$NIGHTLY == null" +ruleString On IpeData = "$CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/" +ruleString Off IpeData = true ruleString On Disable = false ruleString Off Disable = true -- Enumeration of all the rules -rules :: [Rule] -rules = [minBound .. maxBound] +rulesList :: [Rule] +rulesList = [minBound .. maxBound] -- | A 'Job' is the description of a single job in a gitlab pipeline. The -- job contains all the information about how to do the build but can be further @@ -853,10 +878,11 @@ job_groups = , validateBuilds Amd64 (Linux Debian10) nativeInt , fastCI (validateBuilds Amd64 (Linux Debian10) unreg) , fastCI (validateBuilds Amd64 (Linux Debian10) debug) + , disableValidate (validateBuilds Amd64 (Linux Debian10) ipe) , modifyValidateJobs manual tsan_jobs , modifyValidateJobs manual (validateBuilds Amd64 (Linux Debian10) noTntc) , addValidateRule LLVMBackend (validateBuilds Amd64 (Linux Debian10) llvm) - + , addValidateRule IpeData (validateBuilds Amd64 (Linux Debian10) ipe) , disableValidate (standardBuilds Amd64 (Linux Debian11)) -- 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. ===================================== .gitlab/jobs.yaml ===================================== @@ -35,7 +35,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -97,7 +97,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -155,7 +155,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -213,7 +213,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -276,7 +276,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -335,7 +335,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -394,7 +394,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -453,7 +453,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -518,7 +518,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -579,7 +579,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -640,7 +640,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -701,7 +701,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -764,7 +764,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -825,7 +825,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -888,7 +888,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -948,7 +948,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1007,7 +1007,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1031,7 +1031,7 @@ "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb10-numa-slow-validate": { + "nightly-x86_64-linux-deb10-numa-slow-validate+ipe": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -1041,7 +1041,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", + "ghc-x86_64-linux-deb10-numa-slow-validate+ipe.tar.xz", "junit.xml" ], "reports": { @@ -1066,7 +1066,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1083,11 +1083,11 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate", - "BUILD_FLAVOUR": "slow-validate", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate+ipe", + "BUILD_FLAVOUR": "slow-validate+ipe", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", - "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate", + "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate+ipe", "XZ_OPT": "-9" } }, @@ -1126,7 +1126,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1185,7 +1185,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1244,7 +1244,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1268,6 +1268,65 @@ "XZ_OPT": "-9" } }, + "nightly-x86_64-linux-deb10-validate+ipe": { + "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-deb10-validate+ipe.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb10-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$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-deb10-validate+ipe", + "BUILD_FLAVOUR": "validate+ipe", + "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "TEST_ENV": "x86_64-linux-deb10-validate+ipe", + "XZ_OPT": "-9" + } + }, "nightly-x86_64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -1303,7 +1362,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1362,7 +1421,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1423,7 +1482,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1484,7 +1543,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1546,7 +1605,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1605,7 +1664,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1664,7 +1723,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1725,7 +1784,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1787,7 +1846,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1848,7 +1907,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1908,7 +1967,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1967,7 +2026,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2022,7 +2081,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2081,7 +2140,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2144,7 +2203,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2208,7 +2267,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2268,7 +2327,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2328,7 +2387,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2394,7 +2453,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2458,7 +2517,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2522,7 +2581,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2583,7 +2642,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2643,7 +2702,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2703,7 +2762,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2763,7 +2822,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2823,7 +2882,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2885,7 +2944,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2947,7 +3006,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3010,7 +3069,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3071,7 +3130,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3131,7 +3190,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3187,7 +3246,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3247,7 +3306,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3311,7 +3370,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3375,7 +3434,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3435,7 +3494,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3495,7 +3554,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3557,7 +3616,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3616,7 +3675,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3639,7 +3698,7 @@ "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate" } }, - "x86_64-linux-deb10-numa-slow-validate": { + "x86_64-linux-deb10-numa-slow-validate+ipe": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -3649,7 +3708,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", + "ghc-x86_64-linux-deb10-numa-slow-validate+ipe.tar.xz", "junit.xml" ], "reports": { @@ -3674,7 +3733,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3691,11 +3750,11 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate", - "BUILD_FLAVOUR": "slow-validate", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate+ipe", + "BUILD_FLAVOUR": "slow-validate+ipe", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", - "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate" + "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate+ipe" } }, "x86_64-linux-deb10-unreg-validate": { @@ -3733,7 +3792,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3791,7 +3850,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3814,6 +3873,64 @@ "TEST_ENV": "x86_64-linux-deb10-validate+debug_info" } }, + "x86_64-linux-deb10-validate+ipe": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "2 weeks", + "paths": [ + "ghc-x86_64-linux-deb10-validate+ipe.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb10-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$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\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"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-deb10-validate+ipe", + "BUILD_FLAVOUR": "validate+ipe", + "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "TEST_ENV": "x86_64-linux-deb10-validate+ipe" + } + }, "x86_64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -3849,7 +3966,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3908,7 +4025,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3968,7 +4085,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4028,7 +4145,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4089,7 +4206,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4145,7 +4262,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -194,7 +194,7 @@ Note [Type synonym families] * Type synonym families, also known as "type functions", map directly onto the type functions in FC: - type family F a :: * + type family F a :: Type type instance F Int = Bool ..etc... @@ -210,11 +210,11 @@ Note [Type synonym families] type instance F (F Int) = ... -- BAD! * Translation of type family decl: - type family F a :: * + type family F a :: Type translates to a FamilyTyCon 'F', whose FamTyConFlav is OpenSynFamilyTyCon - type family G a :: * where + type family G a :: Type where G Int = Bool G Bool = Char G a = () @@ -229,7 +229,7 @@ Note [Data type families] See also Note [Wrappers for data instance tycons] in GHC.Types.Id.Make * Data type families are declared thus - data family T a :: * + data family T a :: Type data instance T Int = T1 | T2 Bool Here T is the "family TyCon". @@ -321,7 +321,7 @@ See also Note [Wrappers for data instance tycons] in GHC.Types.Id.Make should not think of a data family T as a *type function* at all, not even an injective one! We can't allow even injective type functions on the LHS of a type function: - type family injective G a :: * + type family injective G a :: Type type instance F (G Int) = Bool is no good, even if G is injective, because consider type instance G Int = Bool @@ -572,21 +572,21 @@ Since they are user-callable we must get their type-argument visibility information right; and that info is in the TyConBinders. Here is an example: - data App a b = MkApp (a b) -- App :: forall {k}. (k->*) -> k -> * + data App a b = MkApp (a b) -- App :: forall {k}. (k->Type) -> k -> Type The TyCon has - tyConTyBinders = [ Named (Bndr (k :: *) Inferred), Anon (k->*), Anon k ] + tyConTyBinders = [ Named (Bndr (k :: Type) Inferred), Anon (k->Type), Anon k ] The TyConBinders for App line up with App's kind, given above. But the DataCon MkApp has the type - MkApp :: forall {k} (a:k->*) (b:k). a b -> App k a b + MkApp :: forall {k} (a:k->Type) (b:k). a b -> App k a b That is, its ForAllTyBinders should be - dataConUnivTyVarBinders = [ Bndr (k:*) Inferred - , Bndr (a:k->*) Specified + dataConUnivTyVarBinders = [ Bndr (k:Type) Inferred + , Bndr (a:k->Type) Specified , Bndr (b:k) Specified ] So tyConTyVarBinders converts TyCon's TyConBinders into TyVarBinders: @@ -620,8 +620,8 @@ They fit together like so: type App a (b :: k) = a b - tyConBinders = [ Bndr (k::*) (NamedTCB Inferred) - , Bndr (a:k->*) AnonTCB + tyConBinders = [ Bndr (k::Type) (NamedTCB Inferred) + , Bndr (a:k->Type) AnonTCB , Bndr (b:k) AnonTCB ] Note that there are three binders here, including the @@ -636,13 +636,13 @@ They fit together like so: that TyVar may scope over some other part of the TyCon's definition. Eg type T a = a -> a we have - tyConBinders = [ Bndr (a:*) AnonTCB ] + tyConBinders = [ Bndr (a:Type) AnonTCB ] synTcRhs = a -> a So the 'a' scopes over the synTcRhs * From the tyConBinders and tyConResKind we can get the tyConKind E.g for our App example: - App :: forall k. (k->*) -> k -> * + App :: forall k. (k->Type) -> k -> Type We get a 'forall' in the kind for each NamedTCB, and an arrow for each AnonTCB @@ -725,15 +725,15 @@ instance Binary TyConBndrVis where -- things such as: -- -- 1) Data declarations: @data Foo = ...@ creates the @Foo@ type constructor of --- kind @*@ +-- kind @Type@ -- -- 2) Type synonyms: @type Foo = ...@ creates the @Foo@ type constructor -- -- 3) Newtypes: @newtype Foo a = MkFoo ...@ creates the @Foo@ type constructor --- of kind @* -> *@ +-- of kind @Type -> Type@ -- -- 4) Class declarations: @class Foo where@ creates the @Foo@ type constructor --- of kind @*@ +-- of kind @Constraint@ -- -- This data type also encodes a number of primitive, built in type constructors -- such as those for function and tuple types. @@ -1252,16 +1252,16 @@ data FamTyConFlav -- -- These are introduced by either a top level declaration: -- - -- > data family T a :: * + -- > data family T a :: Type -- -- Or an associated data type declaration, within a class declaration: -- -- > class C a b where - -- > data T b :: * + -- > data T b :: Type DataFamilyTyCon TyConRepName - -- | An open type synonym family e.g. @type family F x y :: * -> *@ + -- | An open type synonym family e.g. @type family F x y :: Type -> Type@ | OpenSynFamilyTyCon -- | A closed type synonym family e.g. ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -163,7 +163,6 @@ $small = [$ascsmall $unismall \_] $uniidchar = \x07 -- Trick Alex into handling Unicode. See Note [Unicode in Alex]. $idchar = [$small $large $digit $uniidchar \'] -$labelchar = [$small $large $digit $uniidchar \' \.] $unigraphic = \x06 -- Trick Alex into handling Unicode. See Note [Unicode in Alex]. $graphic = [$small $large $symbol $digit $idchar $special $unigraphic \"\'] @@ -455,7 +454,7 @@ $unigraphic / { isSmartQuote } { smart_quote_error } } <0> { - "#" $labelchar+ / { ifExtension OverloadedLabelsBit } { skip_one_varid_src ITlabelvarid } + "#" $idchar+ / { ifExtension OverloadedLabelsBit } { skip_one_varid_src ITlabelvarid } "#" \" / { ifExtension OverloadedLabelsBit } { lex_quoted_label } } ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -1,66 +1,187 @@ +{-# LANGUAGE CPP #-} + module GHC.StgToCmm.InfoTableProv (emitIpeBufferListNode) where +import Foreign + +#if defined(HAVE_LIBZSTD) +import Foreign.C.Types +import qualified Data.ByteString.Internal as BSI +import GHC.IO (unsafePerformIO) +#endif + +import GHC.Data.FastString (fastStringToShortText) import GHC.Prelude import GHC.Platform +import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile) import GHC.Unit.Module import GHC.Utils.Outputable -import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile) -import GHC.Data.FastString (fastStringToShortText) +import GHC.Cmm import GHC.Cmm.CLabel -import GHC.Cmm.Expr import GHC.Cmm.Utils import GHC.StgToCmm.Config -import GHC.StgToCmm.Lit (newByteStringCLit) import GHC.StgToCmm.Monad -import GHC.StgToCmm.Utils import GHC.Data.ShortText (ShortText) import qualified GHC.Data.ShortText as ST -import qualified Data.Map.Strict as M import Control.Monad.Trans.State.Strict + import qualified Data.ByteString as BS import qualified Data.ByteString.Builder as BSB import qualified Data.ByteString.Lazy as BSL +import qualified Data.Map.Strict as M + +{- +Note [Compression and Decompression of IPE data] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Compiling with `-finfo-table-map` causes build results to include a map from +info tables to source positions called the info table provenance entry (IPE) +map. See Note [Mapping Info Tables to Source Positions]. The IPE information +can grow the size of build results significantly. At the time of writing, a +default build of GHC results in a total of 109M of libHSghc-*.so build results. +A default+ipe build of GHC (see ./hadrian/doc/flavours.md) results in 262M of +libHSghc-*.so build results without compression. -emitIpeBufferListNode :: Module - -> [InfoProvEnt] - -> FCode () +We reduce the impact of IPE data on the size of build results by compressing +the data before it is emitted using the zstd compression library. See +Note [The Info Table Provenance Entry (IPE) Map] for information on the layout +of IPE data on disk and in the RTS. We cannot simply compress all data held in +the IPE entry buffer, as the pointers to info tables must be converted to +memory addresses during linking. Therefore, we can only compress the strings +table and the IPE entries themselves (which essentially only consist of indices +into the strings table). + +With compression, a default+ipe build of GHC results in a total of 205M of +libHSghc-*.so build results. This is over a 20% reduction from the uncompressed +case. + +Decompression happens lazily, as it only occurs when the IPE map is +constructed (which is also done lazily on first lookup or traversal). During +construction, the 'compressed' field of each IPE buffer list node is examined. +If the field indicates that the data has been compressed, the entry data and +strings table are decompressed before continuing with the normal IPE map +construction. +-} + +emitIpeBufferListNode :: + Module + -> [InfoProvEnt] + -> FCode () emitIpeBufferListNode _ [] = return () emitIpeBufferListNode this_mod ents = do cfg <- getStgToCmmConfig - let ctx = stgToCmmContext cfg + + tables_lbl <- mkStringLitLabel <$> newUnique + strings_lbl <- mkStringLitLabel <$> newUnique + entries_lbl <- mkStringLitLabel <$> newUnique + + let ctx = stgToCmmContext cfg platform = stgToCmmPlatform cfg + int n = mkIntCLit platform n + + (cg_ipes, strtab) = flip runState emptyStringTable $ do + module_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (ppr this_mod) + mapM (toCgIPE platform ctx module_name) ents + + tables :: [CmmStatic] + tables = map (CmmStaticLit . CmmLabel . ipeInfoTablePtr) cg_ipes + + uncompressed_strings :: BS.ByteString + uncompressed_strings = getStringTableStrings strtab + + strings_bytes :: BS.ByteString + strings_bytes = compress defaultCompressionLevel uncompressed_strings + + strings :: [CmmStatic] + strings = [CmmString strings_bytes] + + uncompressed_entries :: BS.ByteString + uncompressed_entries = toIpeBufferEntries (platformByteOrder platform) cg_ipes - let (cg_ipes, strtab) = flip runState emptyStringTable $ do - module_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (ppr this_mod) - mapM (toCgIPE platform ctx module_name) ents - - let -- Emit the fields of an IpeBufferEntry struct. - toIpeBufferEntry :: CgInfoProvEnt -> [CmmLit] - toIpeBufferEntry cg_ipe = - [ CmmLabel (ipeInfoTablePtr cg_ipe) - , strtab_offset (ipeTableName cg_ipe) - , strtab_offset (ipeClosureDesc cg_ipe) - , strtab_offset (ipeTypeDesc cg_ipe) - , strtab_offset (ipeLabel cg_ipe) - , strtab_offset (ipeModuleName cg_ipe) - , strtab_offset (ipeSrcFile cg_ipe) - , strtab_offset (ipeSrcSpan cg_ipe) - , int32 0 - ] - - int n = mkIntCLit platform n - int32 n = CmmInt n W32 - strtab_offset (StrTabOffset n) = int32 (fromIntegral n) - - strings <- newByteStringCLit (getStringTableStrings strtab) - let lits = [ zeroCLit platform -- 'next' field - , strings -- 'strings' field - , int $ length cg_ipes -- 'count' field - ] ++ concatMap toIpeBufferEntry cg_ipes - emitDataLits (mkIPELabel this_mod) lits + entries_bytes :: BS.ByteString + entries_bytes = compress defaultCompressionLevel uncompressed_entries + + entries :: [CmmStatic] + entries = [CmmString entries_bytes] + + ipe_buffer_lbl :: CLabel + ipe_buffer_lbl = mkIPELabel this_mod + + ipe_buffer_node :: [CmmStatic] + ipe_buffer_node = map CmmStaticLit + [ -- 'next' field + zeroCLit platform + + -- 'compressed' field + , int do_compress + + -- 'count' field + , int $ length cg_ipes + + -- 'tables' field + , CmmLabel tables_lbl + + -- 'entries' field + , CmmLabel entries_lbl + + -- 'entries_size' field (decompressed size) + , int $ BS.length uncompressed_entries + + -- 'string_table' field + , CmmLabel strings_lbl + + -- 'string_table_size' field (decompressed size) + , int $ BS.length uncompressed_strings + ] + + -- Emit the list of info table pointers + emitDecl $ CmmData + (Section Data tables_lbl) + (CmmStaticsRaw tables_lbl tables) + + -- Emit the strings table + emitDecl $ CmmData + (Section Data strings_lbl) + (CmmStaticsRaw strings_lbl strings) + + -- Emit the list of IPE buffer entries + emitDecl $ CmmData + (Section Data entries_lbl) + (CmmStaticsRaw entries_lbl entries) + + -- Emit the IPE buffer list node + emitDecl $ CmmData + (Section Data ipe_buffer_lbl) + (CmmStaticsRaw ipe_buffer_lbl ipe_buffer_node) + +-- | Emit the fields of an IpeBufferEntry struct for each entry in a given list. +toIpeBufferEntries :: + ByteOrder -- ^ Byte order to write the data in + -> [CgInfoProvEnt] -- ^ List of IPE buffer entries + -> BS.ByteString +toIpeBufferEntries byte_order cg_ipes = + BSL.toStrict . BSB.toLazyByteString . mconcat + $ map (mconcat . map word32Builder . to_ipe_buf_ent) cg_ipes + where + to_ipe_buf_ent :: CgInfoProvEnt -> [Word32] + to_ipe_buf_ent cg_ipe = + [ ipeTableName cg_ipe + , ipeClosureDesc cg_ipe + , ipeTypeDesc cg_ipe + , ipeLabel cg_ipe + , ipeModuleName cg_ipe + , ipeSrcFile cg_ipe + , ipeSrcSpan cg_ipe + , 0 -- padding + ] + + word32Builder :: Word32 -> BSB.Builder + word32Builder = case byte_order of + BigEndian -> BSB.word32BE + LittleEndian -> BSB.word32LE toCgIPE :: Platform -> SDocContext -> StrTabOffset -> InfoProvEnt -> State StringTable CgInfoProvEnt toCgIPE platform ctx module_name ipe = do @@ -76,7 +197,7 @@ toCgIPE platform ctx module_name ipe = do coords = renderWithContext ctx (pprUserRealSpan False span) in (file, coords) label <- lookupStringTable $ ST.pack label_str - src_file <- lookupStringTable $ src_loc_file + src_file <- lookupStringTable src_loc_file src_span <- lookupStringTable $ ST.pack src_loc_span return $ CgInfoProvEnt { ipeInfoTablePtr = infoTablePtr ipe , ipeTableName = table_name @@ -104,7 +225,7 @@ data StringTable = StringTable { stStrings :: DList ShortText , stLookup :: !(M.Map ShortText StrTabOffset) } -newtype StrTabOffset = StrTabOffset Int +type StrTabOffset = Word32 emptyStringTable :: StringTable emptyStringTable = @@ -129,9 +250,50 @@ lookupStringTable str = state $ \st -> , stLength = stLength st + ST.byteLength str + 1 , stLookup = M.insert str res (stLookup st) } - res = StrTabOffset (stLength st) + res = fromIntegral (stLength st) in (res, st') +do_compress :: Int +compress :: Int -> BS.ByteString -> BS.ByteString +#if !defined(HAVE_LIBZSTD) +do_compress = 0 +compress _ bs = bs +#else +do_compress = 1 + +compress clvl (BSI.PS srcForeignPtr off len) = unsafePerformIO $ + withForeignPtr srcForeignPtr $ \srcPtr -> do + maxCompressedSize <- zstd_compress_bound $ fromIntegral len + dstForeignPtr <- BSI.mallocByteString (fromIntegral maxCompressedSize) + withForeignPtr dstForeignPtr $ \dstPtr -> do + compressedSize <- fromIntegral <$> + zstd_compress + dstPtr + maxCompressedSize + (srcPtr `plusPtr` off) + (fromIntegral len) + (fromIntegral clvl) + BSI.create compressedSize $ \p -> BSI.memcpy p dstPtr compressedSize + +foreign import ccall unsafe "ZSTD_compress" + zstd_compress :: + Ptr dst -- ^ Destination buffer + -> CSize -- ^ Capacity of destination buffer + -> Ptr src -- ^ Source buffer + -> CSize -- ^ Size of source buffer + -> CInt -- ^ Compression level + -> IO CSize + +-- | Compute the maximum compressed size for a given source buffer size +foreign import ccall unsafe "ZSTD_compressBound" + zstd_compress_bound :: + CSize -- ^ Size of source buffer + -> IO CSize +#endif + +defaultCompressionLevel :: Int +defaultCompressionLevel = 3 + newtype DList a = DList ([a] -> [a]) emptyDList :: DList a ===================================== compiler/ghc.cabal.in ===================================== @@ -57,6 +57,10 @@ Flag build-tool-depends Description: Use build-tool-depends Default: True +Flag with-libzstd + Default: False + Manual: True + Library Default-Language: Haskell2010 Exposed: False @@ -71,6 +75,10 @@ Library if flag(build-tool-depends) build-tool-depends: alex:alex >= 3.2.6, happy:happy >= 1.20.0, genprimopcode:genprimopcode, deriveConstants:deriveConstants + if flag(with-libzstd) + extra-libraries: zstd + CPP-Options: -DHAVE_LIBZSTD + Build-Depends: base >= 4.11 && < 4.19, deepseq >= 1.4 && < 1.5, directory >= 1 && < 1.4, ===================================== configure.ac ===================================== @@ -1122,6 +1122,10 @@ AC_DEFINE_UNQUOTED([RTS_LINKER_USE_MMAP], [$RtsLinkerUseMmap], GHC_ADJUSTORS_METHOD([Target]) AC_SUBST([UseLibffiForAdjustors]) +dnl ** IPE data compression +dnl -------------------------------------------------------------- +FP_FIND_LIBZSTD + dnl ** Other RTS features dnl -------------------------------------------------------------- FP_FIND_LIBDW @@ -1267,6 +1271,17 @@ echo "\ makeinfo : $MAKEINFO git : $GIT cabal-install : $CABAL +" + +USING_LIBNUMA=$(if [ "$HaveLibNuma" = "1" ]; then echo "YES"; else echo "NO"; fi;) +USING_LIBZSTD=$(if [ "$HaveLibZstd" = "1" ]; then echo "YES"; else echo "NO"; fi;) +USING_LIBDW=$(if [ "$USE_LIBDW" = "1" ]; then echo "YES"; else echo "NO"; fi;) + +echo "\ + Using optional dependencies: + libnuma : $USING_LIBNUMA + libzstd : $USING_LIBZSTD + libdw : $USING_LIBDW Using LLVM tools clang : $ClangCmd ===================================== docs/users_guide/9.6.1-notes.rst ===================================== @@ -84,7 +84,7 @@ Language This extends the variety syntax for constructing labels under :extension:`OverloadedLabels`. Examples of newly allowed syntax: - Leading capital letters: `#Foo` equivalant to `getLabel @"Foo"` - - Numeric characters: `#3.14` equivalent to `getLabel @"3.14"` + - Numeric characters: `#1728` equivalent to `getLabel @"1728"` - Arbitrary strings: `#"Hello, World!"` equivalent to `getLabel @"Hello, World!"` Compiler ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -21,6 +21,17 @@ Compiler foo (\x -> x*2 + x) +- The compiler may now be configured to compress the debugging information + included in :ghc-flag:`-finfo-table-map` enabled binaries. To do so, one must + build GHC from source (see + `here` for directions) + and supply the ``--enable-ipe-data-compression`` flag to the ``configure`` + script. **Note**: This feature requires that the machine building GHC has + `libzstd `_ installed. + + In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map` + enabled build results was reduced by over 20% when compression was enabled. + GHCi ~~~~ ===================================== docs/users_guide/debug-info.rst ===================================== @@ -370,9 +370,23 @@ to a source location. This lookup table is generated by using the ``-finfo-table also want more precise information about constructor info tables then you should also use :ghc-flag:`-fdistinct-constructor-tables`. - This flag will increase the binary size by quite a lot, depending on how - big your project is. For compiling a project the size of GHC the overhead was - about 200 megabytes. + The :ghc-flag:`-finfo-table-map` flag will increase the binary size by quite + a lot, depending on how big your project is. For compiling a project the + size of GHC the overhead was about 200 megabytes. + + :since: 9.8 + + If you wish to reduce the size of :ghc-flag:`-finfo-table-map` enabled + binaries, consider building GHC from source and supplying the + ``--enable-ipe-data-compression`` flag to the ``configure`` script. This + will cause GHC to compress the :ghc-flag:`-finfo-table-map` related + debugging information included in binaries using the `libzstd + `_ compression library. **Note**: This + feature requires that the machine building GHC has + `libzstd `_ installed. + + In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map` + enabled build results was reduced by over 20% when compression was enabled. .. ghc-flag:: -fdistinct-constructor-tables :shortdesc: Generate a fresh info table for each usage ===================================== hadrian/cfg/system.config.in ===================================== @@ -200,10 +200,14 @@ libdw-lib-dir = @LibdwLibDir@ libnuma-include-dir = @LibNumaIncludeDir@ libnuma-lib-dir = @LibNumaLibDir@ +libzstd-include-dir = @LibZstdIncludeDir@ +libzstd-lib-dir = @LibZstdLibDir@ + # Optional Dependencies: #======================= use-lib-dw = @UseLibdw@ +use-lib-zstd = @UseLibZstd@ use-lib-numa = @UseLibNuma@ use-lib-m = @UseLibm@ use-lib-rt = @UseLibrt@ ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -35,6 +35,7 @@ data Flag = ArSupportsAtFile | UseLibffiForAdjustors | UseLibdw | UseLibnuma + | UseLibzstd | UseLibm | UseLibrt | UseLibdl @@ -65,6 +66,7 @@ flag f = do UseLibffiForAdjustors -> "use-libffi-for-adjustors" UseLibdw -> "use-lib-dw" UseLibnuma -> "use-lib-numa" + UseLibzstd -> "use-lib-zstd" UseLibm -> "use-lib-m" UseLibrt -> "use-lib-rt" UseLibdl -> "use-lib-dl" ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -60,6 +60,8 @@ data Setting = BuildArch | LibdwLibDir | LibnumaIncludeDir | LibnumaLibDir + | LibZstdIncludeDir + | LibZstdLibDir | LlvmTarget | ProjectGitCommitId | ProjectName @@ -162,6 +164,8 @@ setting key = lookupSystemConfig $ case key of LibdwLibDir -> "libdw-lib-dir" LibnumaIncludeDir -> "libnuma-include-dir" LibnumaLibDir -> "libnuma-lib-dir" + LibZstdIncludeDir -> "libzstd-include-dir" + LibZstdLibDir -> "libzstd-lib-dir" LlvmTarget -> "llvm-target" ProjectGitCommitId -> "project-git-commit-id" ProjectName -> "project-name" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -291,6 +291,7 @@ rtsCabalFlags = mconcat , flag "CabalNeedLibpthread" UseLibpthread , flag "CabalHaveLibbfd" UseLibbfd , flag "CabalHaveLibNuma" UseLibnuma + , flag "CabalHaveLibZstd" UseLibzstd , flag "CabalNeedLibatomic" NeedLibatomic , flag "CabalUseSystemLibFFI" UseSystemFfi , flag "CabalLibffiAdjustors" UseLibffiForAdjustors ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -77,6 +77,7 @@ packageArgs = do [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" , notM cross `cabalFlag` "terminfo" , arg "-build-tool-depends" + , flag UseLibzstd `cabalFlag` "with-libzstd" ] , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] @@ -286,6 +287,8 @@ rtsPackageArgs = package rts ? do libdwLibraryDir <- getSetting LibdwLibDir libnumaIncludeDir <- getSetting LibnumaIncludeDir libnumaLibraryDir <- getSetting LibnumaLibDir + libzstdIncludeDir <- getSetting LibZstdIncludeDir + libzstdLibraryDir <- getSetting LibZstdLibDir -- Arguments passed to GHC when compiling C and .cmm sources. let ghcArgs = mconcat @@ -392,6 +395,7 @@ rtsPackageArgs = package rts ? do , builder (Cabal Setup) ? mconcat [ cabalExtraDirs libdwIncludeDir libdwLibraryDir , cabalExtraDirs libnumaIncludeDir libnumaLibraryDir + , cabalExtraDirs libzstdIncludeDir libzstdLibraryDir , useSystemFfi ? cabalExtraDirs ffiIncludeDir ffiLibraryDir ] , builder (Cc (FindCDependencies CDep)) ? cArgs ===================================== libraries/base/GHC/Int.hs ===================================== @@ -69,8 +69,8 @@ instance Eq Int8 where (/=) = neInt8 eqInt8, neInt8 :: Int8 -> Int8 -> Bool -eqInt8 (I8# x) (I8# y) = isTrue# (x `eqInt8#` y) -neInt8 (I8# x) (I8# y) = isTrue# (x `neInt8#` y) +eqInt8 (I8# x) (I8# y) = isTrue# ((int8ToInt# x) ==# (int8ToInt# y)) +neInt8 (I8# x) (I8# y) = isTrue# ((int8ToInt# x) /=# (int8ToInt# y)) {-# INLINE [1] eqInt8 #-} {-# INLINE [1] neInt8 #-} @@ -280,8 +280,8 @@ instance Eq Int16 where (/=) = neInt16 eqInt16, neInt16 :: Int16 -> Int16 -> Bool -eqInt16 (I16# x) (I16# y) = isTrue# (x `eqInt16#` y) -neInt16 (I16# x) (I16# y) = isTrue# (x `neInt16#` y) +eqInt16 (I16# x) (I16# y) = isTrue# ((int16ToInt# x) ==# (int16ToInt# y)) +neInt16 (I16# x) (I16# y) = isTrue# ((int16ToInt# x) /=# (int16ToInt# y)) {-# INLINE [1] eqInt16 #-} {-# INLINE [1] neInt16 #-} @@ -488,8 +488,8 @@ instance Eq Int32 where (/=) = neInt32 eqInt32, neInt32 :: Int32 -> Int32 -> Bool -eqInt32 (I32# x) (I32# y) = isTrue# (x `eqInt32#` y) -neInt32 (I32# x) (I32# y) = isTrue# (x `neInt32#` y) +eqInt32 (I32# x) (I32# y) = isTrue# ((int32ToInt# x) ==# (int32ToInt# y)) +neInt32 (I32# x) (I32# y) = isTrue# ((int32ToInt# x) /=# (int32ToInt# y)) {-# INLINE [1] eqInt32 #-} {-# INLINE [1] neInt32 #-} ===================================== libraries/base/GHC/Word.hs ===================================== @@ -78,8 +78,8 @@ instance Eq Word8 where (/=) = neWord8 eqWord8, neWord8 :: Word8 -> Word8 -> Bool -eqWord8 (W8# x) (W8# y) = isTrue# (x `eqWord8#` y) -neWord8 (W8# x) (W8# y) = isTrue# (x `neWord8#` y) +eqWord8 (W8# x) (W8# y) = isTrue# ((word8ToWord# x) `eqWord#` (word8ToWord# y)) +neWord8 (W8# x) (W8# y) = isTrue# ((word8ToWord# x) `neWord#` (word8ToWord# y)) {-# INLINE [1] eqWord8 #-} {-# INLINE [1] neWord8 #-} @@ -268,8 +268,8 @@ instance Eq Word16 where (/=) = neWord16 eqWord16, neWord16 :: Word16 -> Word16 -> Bool -eqWord16 (W16# x) (W16# y) = isTrue# (x `eqWord16#` y) -neWord16 (W16# x) (W16# y) = isTrue# (x `neWord16#` y) +eqWord16 (W16# x) (W16# y) = isTrue# ((word16ToWord# x) `eqWord#` (word16ToWord# y)) +neWord16 (W16# x) (W16# y) = isTrue# ((word16ToWord# x) `neWord#` (word16ToWord# y)) {-# INLINE [1] eqWord16 #-} {-# INLINE [1] neWord16 #-} @@ -500,8 +500,8 @@ instance Eq Word32 where (/=) = neWord32 eqWord32, neWord32 :: Word32 -> Word32 -> Bool -eqWord32 (W32# x) (W32# y) = isTrue# (x `eqWord32#` y) -neWord32 (W32# x) (W32# y) = isTrue# (x `neWord32#` y) +eqWord32 (W32# x) (W32# y) = isTrue# ((word32ToWord# x) `eqWord#` (word32ToWord# y)) +neWord32 (W32# x) (W32# y) = isTrue# ((word32ToWord# x) `neWord#` (word32ToWord# y)) {-# INLINE [1] eqWord32 #-} {-# INLINE [1] neWord32 #-} ===================================== m4/fp_find_libnuma.m4 ===================================== @@ -30,7 +30,7 @@ AC_DEFUN([FP_FIND_LIBNUMA], [Enable NUMA memory policy and thread affinity support in the runtime system via numactl's libnuma [default=auto]])]) - if test "$enable_numa" != "no" ; then + if test "$enable_numa" = "yes" ; then CFLAGS2="$CFLAGS" CFLAGS="$LIBNUMA_CFLAGS $CFLAGS" LDFLAGS2="$LDFLAGS" @@ -41,7 +41,7 @@ AC_DEFUN([FP_FIND_LIBNUMA], if test "$ac_cv_header_numa_h$ac_cv_header_numaif_h" = "yesyes" ; then AC_CHECK_LIB(numa, numa_available,HaveLibNuma=1) fi - if test "$enable_numa:$HaveLibNuma" = "yes:0" ; then + if test "$HaveLibNuma" = "0" ; then AC_MSG_ERROR([Cannot find system libnuma (required by --enable-numa)]) fi ===================================== m4/fp_find_libzstd.m4 ===================================== @@ -0,0 +1,79 @@ +AC_DEFUN([FP_FIND_LIBZSTD], +[ + dnl ** Is IPE data compression enabled? + dnl -------------------------------------------------------------- + AC_ARG_ENABLE( + ipe-data-compression, + [AS_HELP_STRING( + [--enable-ipe-data-compression], + [Enable compression of info table provenance entries using the + zstd compression library [default=no]] + )], + [FP_CAPITALIZE_YES_NO(["$enableval"], [EnableIpeDataCompression])], + [EnableIpeDataCompression=NO] + ) + + HaveLibZstd=0 + if test "$EnableIpeDataCompression" = "YES"; then + dnl ** Have zstd? + dnl -------------------------------------------------------------- + AC_ARG_WITH( + libzstd-libraries, + [AS_HELP_STRING( + [--with-libzstd-libraries=ARG], + [Find libraries for libzstd in ARG [default=system default]] + )], + [ + LibZstdLibDir="$withval" + LIBZSTD_LDFLAGS="-L$withval" + ] + ) + + AC_SUBST(LibZstdLibDir) + + AC_ARG_WITH( + libzstd-includes, + [AS_HELP_STRING( + [--with-libzstd-includes=ARG], + [Find includes for libzstd in ARG [default=system default]] + )], + [ + LibZstdIncludeDir="$withval" + LIBZSTD_CFLAGS="-I$withval" + ] + ) + + AC_SUBST(LibZstdIncludeDir) + + CFLAGS2="$CFLAGS" + CFLAGS="$LIBZSTD_CFLAGS $CFLAGS" + LDFLAGS2="$LDFLAGS" + LDFLAGS="$LIBZSTD_LDFLAGS $LDFLAGS" + + AC_CHECK_HEADERS([zstd.h]) + + if test "$ac_cv_header_zstd_h" = "yes" ; then + AC_CHECK_LIB(zstd,ZSTD_versionString,HaveLibZstd=1) + fi + if test "$HaveLibZstd" = "0" ; then + AC_MSG_ERROR( + [Cannot find system libzstd (required by + --enable-ipe-data-compression)] + ) + fi + + CFLAGS="$CFLAGS2" + LDFLAGS="$LDFLAGS2" + fi + + AC_DEFINE_UNQUOTED([HAVE_LIBZSTD], [$HaveLibZstd], [Define to 1 if you + wish to compress IPE data in compiler results (requires libzstd)]) + + if test $HaveLibZstd = "1" ; then + AC_SUBST([UseLibZstd],[YES]) + AC_SUBST([CabalHaveLibZstd],[True]) + else + AC_SUBST([UseLibZstd],[NO]) + AC_SUBST([CabalHaveLibZstd],[False]) + fi +]) ===================================== rts/IPE.c ===================================== @@ -20,6 +20,10 @@ #include #include +#if HAVE_LIBZSTD == 1 +#include +#endif + #if defined(TRACING) #include "Trace.h" #endif @@ -36,8 +40,9 @@ collecting IPE lists on registration. It's a singly linked list of IPE list buffers (IpeBufferListNode). These are emitted by the code generator, with generally one produced per module. Each -contains an array of IPE entries and a link field (which is used to link -buffers onto the pending list. +contains a pointer to a list of IPE entries, a pointer to a list of info +table pointers, and a link field (which is used to link buffers onto the +pending list. For reasons of space efficiency, IPE entries are represented slightly differently in the object file than the InfoProvEnt which we ultimately expose @@ -77,23 +82,23 @@ void exitIpe(void) { } #endif // THREADED_RTS -static InfoProvEnt ipeBufferEntryToIpe(const IpeBufferListNode *node, const IpeBufferEntry *ent) +static InfoProvEnt ipeBufferEntryToIpe(const char *strings, const StgInfoTable *tbl, const IpeBufferEntry ent) { - const char *strings = node->string_table; return (InfoProvEnt) { - .info = ent->info, + .info = tbl, .prov = { - .table_name = &strings[ent->table_name], - .closure_desc = &strings[ent->closure_desc], - .ty_desc = &strings[ent->ty_desc], - .label = &strings[ent->label], - .module = &strings[ent->module_name], - .src_file = &strings[ent->src_file], - .src_span = &strings[ent->src_span] + .table_name = &strings[ent.table_name], + .closure_desc = &strings[ent.closure_desc], + .ty_desc = &strings[ent.ty_desc], + .label = &strings[ent.label], + .module = &strings[ent.module_name], + .src_file = &strings[ent.src_file], + .src_span = &strings[ent.src_span] } }; } + #if defined(TRACING) static void traceIPEFromHashTable(void *data STG_UNUSED, StgWord key STG_UNUSED, const void *value) { @@ -105,8 +110,18 @@ void dumpIPEToEventLog(void) { // Dump pending entries IpeBufferListNode *cursor = RELAXED_LOAD(&ipeBufferList); while (cursor != NULL) { + IpeBufferEntry *entries; + char *strings; + + // Decompress if compressed + decompressIPEBufferListNodeIfCompressed(cursor, &entries, &strings); + for (uint32_t i = 0; i < cursor->count; i++) { - const InfoProvEnt ent = ipeBufferEntryToIpe(cursor, &cursor->entries[i]); + const InfoProvEnt ent = ipeBufferEntryToIpe( + strings, + cursor->tables[i], + entries[i] + ); traceIPE(&ent); } cursor = cursor->next; @@ -120,6 +135,7 @@ void dumpIPEToEventLog(void) { RELEASE_LOCK(&ipeMapLock); } + #else void dumpIPEToEventLog(void) { } @@ -169,16 +185,84 @@ void updateIpeMap() { } while (pending != NULL) { - IpeBufferListNode *currentNode = pending; - InfoProvEnt *ip_ents = stgMallocBytes(sizeof(InfoProvEnt) * currentNode->count, "updateIpeMap"); - for (uint32_t i = 0; i < currentNode->count; i++) { - const IpeBufferEntry *ent = ¤tNode->entries[i]; - ip_ents[i] = ipeBufferEntryToIpe(currentNode, ent); - insertHashTable(ipeMap, (StgWord) ent->info, &ip_ents[i]); + IpeBufferListNode *current_node = pending; + const IpeBufferEntry *entries; + const char *strings; + + // Decompress if compressed + decompressIPEBufferListNodeIfCompressed(current_node, &entries, &strings); + + // Convert the on-disk IPE buffer entry representation (IpeBufferEntry) + // into the runtime representation (InfoProvEnt) + InfoProvEnt *ip_ents = stgMallocBytes( + sizeof(InfoProvEnt) * current_node->count, + "updateIpeMap: ip_ents" + ); + for (uint32_t i = 0; i < current_node->count; i++) { + const IpeBufferEntry ent = entries[i]; + const StgInfoTable *tbl = current_node->tables[i]; + ip_ents[i] = ipeBufferEntryToIpe(strings, tbl, ent); + insertHashTable(ipeMap, (StgWord) tbl, &ip_ents[i]); } - pending = currentNode->next; + pending = current_node->next; } RELEASE_LOCK(&ipeMapLock); } + +/* Decompress the IPE data and strings table referenced by an IPE buffer list +node if it is compressed. No matter whether the data is compressed, the pointers +referenced by the 'entries_dst' and 'string_table_dst' parameters will point at +the decompressed IPE data and string table for the given node, respectively, +upon return from this function. +*/ +void decompressIPEBufferListNodeIfCompressed(IpeBufferListNode *node, IpeBufferEntry **entries_dst, char **string_table_dst) { + if (node->compressed) { + // The IPE list buffer node indicates that the strings table and + // entries list has been compressed. If zstd is not available, fail. + // If zstd is available, decompress. +#if HAVE_LIBZSTD == 0 + barf("An IPE buffer list node has been compressed, but the \ + decompression library (zstd) is not available."); +#else + size_t compressed_sz = ZSTD_findFrameCompressedSize( + node->string_table, + node->string_table_size + ); + char *decompressed_strings = stgMallocBytes( + node->string_table_size, + "updateIpeMap: decompressed_strings" + ); + ZSTD_decompress( + decompressed_strings, + node->string_table_size, + node->string_table, + compressed_sz + ); + *string_table_dst = decompressed_strings; + + // Decompress the IPE data + compressed_sz = ZSTD_findFrameCompressedSize( + node->entries, + node->entries_size + ); + void *decompressed_entries = stgMallocBytes( + node->entries_size, + "updateIpeMap: decompressed_entries" + ); + ZSTD_decompress( + decompressed_entries, + node->entries_size, + node->entries, + compressed_sz + ); + *entries_dst = decompressed_entries; +#endif // HAVE_LIBZSTD == 0 + + } else { + // Not compressed, no need to decompress + *entries_dst = node->entries; + *string_table_dst = node->string_table; + } +} ===================================== rts/IPE.h ===================================== @@ -17,5 +17,6 @@ void dumpIPEToEventLog(void); void updateIpeMap(void); void initIpe(void); void exitIpe(void); +void decompressIPEBufferListNodeIfCompressed(IpeBufferListNode*, IpeBufferEntry**, char**); #include "EndPrivate.h" ===================================== rts/include/rts/IPE.h ===================================== @@ -52,9 +52,6 @@ typedef uint32_t StringIdx; // The size of this must be a multiple of the word size // to ensure correct packing. typedef struct { - // When TNTC is enabled this will point to the entry code - // not the info table itself. - const StgInfoTable *info; StringIdx table_name; StringIdx closure_desc; StringIdx ty_desc; @@ -69,10 +66,23 @@ GHC_STATIC_ASSERT(sizeof(IpeBufferEntry) % (WORD_SIZE_IN_BITS / 8) == 0, "sizeof typedef struct IpeBufferListNode_ { struct IpeBufferListNode_ *next; + // Everything below is read-only and generated by the codegen - const char *string_table; + + // This flag should be treated as a boolean + StgWord compressed; + StgWord count; - IpeBufferEntry entries[]; + + // When TNTC is enabled, these will point to the entry code + // not the info table itself. + StgInfoTable **tables; + + IpeBufferEntry *entries; + StgWord entries_size; // decompressed size + + char *string_table; + StgWord string_table_size; // decompressed size } IpeBufferListNode; void registerInfoProvList(IpeBufferListNode *node); ===================================== rts/rts.cabal.in ===================================== @@ -45,6 +45,8 @@ flag libdw default: @CabalHaveLibdw@ flag libnuma default: @CabalHaveLibNuma@ +flag libzstd + default: @CabalHaveLibZstd@ flag 64bit default: @Cabal64bit@ flag leading-underscore @@ -212,6 +214,8 @@ library extra-libraries: elf dw if flag(libnuma) extra-libraries: numa + if flag(libzstd) + extra-libraries: zstd if !flag(smp) cpp-options: -DNOSMP ===================================== testsuite/tests/overloadedrecflds/should_run/T11671_run.hs ===================================== @@ -12,8 +12,9 @@ import GHC.Prim (Addr#) instance KnownSymbol symbol => IsLabel symbol String where fromLabel = symbolVal (Proxy :: Proxy symbol) -(#) :: String -> Int -> String +(#), (#.) :: String -> Int -> String (#) _ i = show i +_ #. i = show i f :: Addr# -> Int -> String f _ i = show i @@ -26,13 +27,13 @@ main = traverse_ putStrLn , #type , #Foo , #3 - , #199.4 + , #"199.4" , #17a23b , #f'a' , #'a' , #' , #''notTHSplice - , #... + , #"..." , #привет , #こんにちは , #"3" ===================================== testsuite/tests/printer/Test22771.hs ===================================== @@ -14,8 +14,9 @@ import GHC.Prim (Addr#) instance KnownSymbol symbol => IsLabel symbol String where fromLabel = symbolVal (Proxy :: Proxy symbol) -(#) :: String -> Int -> String +(#), (#.) :: String -> Int -> String (#) _ i = show i +_ #. i = show i f :: Addr# -> Int -> String f _ i = show i @@ -28,13 +29,13 @@ main = traverse_ putStrLn , #type , #Foo , #3 - , #199.4 + , #"199.4" , #17a23b , #f'a' , #'a' , #' , #''notTHSplice - , #... + , #"..." , #привет , #こんにちは , #"3" ===================================== testsuite/tests/rts/ipe/ipeEventLog_fromMap.c ===================================== @@ -19,7 +19,7 @@ int main(int argc, char *argv[]) { registerInfoProvList(list2); // Query an IPE to initialize the underlying hash map. - lookupIPE(list1->entries[0].info); + lookupIPE(list1->tables[0]); // Trace all IPE events. dumpIPEToEventLog(); ===================================== testsuite/tests/rts/ipe/ipeMap.c ===================================== @@ -40,15 +40,23 @@ void shouldFindNothingInAnEmptyIPEMap(Capability *cap) { } HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) { - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + sizeof(IpeBufferEntry)); + // Allocate buffers for IPE buffer list node + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); + node->tables = malloc(sizeof(StgInfoTable *)); + node->entries = malloc(sizeof(IpeBufferEntry)); + StringTable st; init_string_table(&st); HaskellObj fortyTwo = UNTAG_CLOSURE(rts_mkInt(cap, 42)); - node->entries[0] = makeAnyProvEntry(cap, &st, fortyTwo, 42); - node->count = 1; node->next = NULL; + node->compressed = 0; + node->count = 1; + node->tables[0] = get_itbl(fortyTwo); + node->entries[0] = makeAnyProvEntry(cap, &st, 42); + node->entries_size = sizeof(IpeBufferEntry); node->string_table = st.buffer; + node->string_table_size = st.size; registerInfoProvList(node); @@ -72,15 +80,23 @@ HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) { void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap, HaskellObj fortyTwo) { - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + sizeof(IpeBufferEntry)); + // Allocate buffers for IPE buffer list node + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); + node->tables = malloc(sizeof(StgInfoTable *)); + node->entries = malloc(sizeof(IpeBufferEntry)); + StringTable st; init_string_table(&st); HaskellObj twentyThree = UNTAG_CLOSURE(rts_mkInt8(cap, 23)); - node->entries[0] = makeAnyProvEntry(cap, &st, twentyThree, 23); - node->count = 1; node->next = NULL; + node->compressed = 0; + node->count = 1; + node->tables[0] = get_itbl(twentyThree); + node->entries[0] = makeAnyProvEntry(cap, &st, 23); + node->entries_size = sizeof(IpeBufferEntry); node->string_table = st.buffer; + node->string_table_size = st.size; registerInfoProvList(node); @@ -103,17 +119,26 @@ void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap, } void shouldFindTwoFromTheSameList(Capability *cap) { - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + 2 * sizeof(IpeBufferEntry)); + // Allocate buffers for IPE buffer list node + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); + node->tables = malloc(sizeof(StgInfoTable *) * 2); + node->entries = malloc(sizeof(IpeBufferEntry) * 2); + StringTable st; init_string_table(&st); HaskellObj one = UNTAG_CLOSURE(rts_mkInt16(cap, 1)); HaskellObj two = UNTAG_CLOSURE(rts_mkInt32(cap, 2)); - node->entries[0] = makeAnyProvEntry(cap, &st, one, 1); - node->entries[1] = makeAnyProvEntry(cap, &st, two, 2); - node->count = 2; node->next = NULL; + node->compressed = 0; + node->count = 2; + node->tables[0] = get_itbl(one); + node->tables[1] = get_itbl(two); + node->entries[0] = makeAnyProvEntry(cap, &st, 1); + node->entries[1] = makeAnyProvEntry(cap, &st, 2); + node->entries_size = sizeof(IpeBufferEntry) * 2; node->string_table = st.buffer; + node->string_table_size = st.size; registerInfoProvList(node); ===================================== testsuite/tests/rts/ipe/ipe_lib.c ===================================== @@ -25,9 +25,8 @@ uint32_t add_string(StringTable *st, const char *s) { return n; } -IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj closure, int i) { +IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, int i) { IpeBufferEntry provEnt; - provEnt.info = get_itbl(closure); unsigned int tableNameLength = strlen("table_name_") + 3 /* digits */ + 1 /* null character */; char *tableName = malloc(sizeof(char) * tableNameLength); @@ -69,15 +68,27 @@ IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj clo IpeBufferListNode *makeAnyProvEntries(Capability *cap, int start, int end) { const int n = end - start; - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + n * sizeof(IpeBufferEntry)); + + // Allocate buffers for IpeBufferListNode + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); + node->tables = malloc(sizeof(StgInfoTable *) * n); + node->entries = malloc(sizeof(IpeBufferEntry) * n); + StringTable st; init_string_table(&st); + + // Make the entries and fill the buffers for (int i=start; i < end; i++) { HaskellObj closure = rts_mkInt(cap, 42); - node->entries[i] = makeAnyProvEntry(cap, &st, closure, i); + node->tables[i] = get_itbl(closure); + node->entries[i] = makeAnyProvEntry(cap, &st, i); } + + // Set the rest of the fields node->next = NULL; + node->compressed = 0; node->count = n; node->string_table = st.buffer; + return node; } ===================================== testsuite/tests/rts/ipe/ipe_lib.h ===================================== @@ -12,6 +12,6 @@ void init_string_table(StringTable *st); uint32_t add_string(StringTable *st, const char *s); IpeBufferListNode *makeAnyProvEntries(Capability *cap, int start, int end); -IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj closure, int i); +IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, int i); void dumpIPEToEventLog(void); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/921e9536350c9210fae2604a603d214b3c673ca6...a240bf498894b60c4b4b1c1935fbe0a15bbc74a2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/921e9536350c9210fae2604a603d214b3c673ca6...a240bf498894b60c4b4b1c1935fbe0a15bbc74a2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 02:25:33 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 07 Feb 2023 21:25:33 -0500 Subject: [Git][ghc/ghc][master] JS: avoid head/tail and unpackFS Message-ID: <63e3081de7bc3_730ce52724428ca@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - 1 changed file: - compiler/GHC/StgToJS/Printer.hs Changes: ===================================== compiler/GHC/StgToJS/Printer.hs ===================================== @@ -108,19 +108,17 @@ ghcjsRenderJsV r (JHash m) where quoteIfRequired :: FastString -> Doc quoteIfRequired x - | isUnquotedKey x' = text x' - | otherwise = PP.squotes (text x') - where x' = unpackFS x - - isUnquotedKey :: String -> Bool - isUnquotedKey x | null x = False - | all isDigit x = True - | otherwise = validFirstIdent (head x) - && all validOtherIdent (tail x) + | isUnquotedKey x = ftext x + | otherwise = PP.squotes (ftext x) + isUnquotedKey :: FastString -> Bool + isUnquotedKey fs = case unpackFS fs of + [] -> False + s@(c:cs) -> all isDigit s || (validFirstIdent c && all validOtherIdent cs) validFirstIdent c = c == '_' || c == '$' || isAlpha c validOtherIdent c = isAlpha c || isDigit c + ghcjsRenderJsV r v = renderJsV defaultRenderJs r v prettyBlock :: RenderJs -> [JStat] -> Doc View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1670c6bb0be68942f1e469334f2004544da6635 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1670c6bb0be68942f1e469334f2004544da6635 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 02:26:10 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 07 Feb 2023 21:26:10 -0500 Subject: [Git][ghc/ghc][master] testsuite: Fix Python warnings (#22856) Message-ID: <63e308427a4bd_730ce549704653b@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 2 changed files: - testsuite/driver/runtests.py - testsuite/driver/testlib.py Changes: ===================================== testsuite/driver/runtests.py ===================================== @@ -601,6 +601,7 @@ else: if args.junit: junit(t).write(args.junit) + args.junit.close() if config.only_report_hadrian_deps: print("WARNING - skipping all tests and only reporting required hadrian dependencies:", config.hadrian_deps) ===================================== testsuite/driver/testlib.py ===================================== @@ -1347,7 +1347,7 @@ def do_test(name: TestName, # if found and instead have the testsuite decide on what to do # with the output. def override_options(pre_cmd): - if config.verbose >= 5 and bool(re.match('\$make', pre_cmd, re.I)): + if config.verbose >= 5 and bool(re.match(r'\$make', pre_cmd, re.I)): return pre_cmd.replace(' -s' , '') \ .replace('--silent', '') \ .replace('--quiet' , '') @@ -1989,7 +1989,7 @@ def split_file(in_fn: Path, delimiter: str, out1_fn: Path, out2_fn: Path): with out1_fn.open('w', encoding='utf8', newline='') as out1: with out2_fn.open('w', encoding='utf8', newline='') as out2: line = infile.readline() - while re.sub('^\s*','',line) != delimiter and line != '': + while re.sub(r'^\s*','',line) != delimiter and line != '': out1.write(line) line = infile.readline() @@ -2399,20 +2399,20 @@ def normalise_errmsg(s: str) -> str: # warning message to get clean output. if config.msys: s = re.sub('Failed to remove file (.*); error= (.*)$', '', s) - s = re.sub('DeleteFile "(.+)": permission denied \(Access is denied\.\)(.*)$', '', s) + s = re.sub(r'DeleteFile "(.+)": permission denied \(Access is denied\.\)(.*)$', '', s) # filter out unsupported GNU_PROPERTY_TYPE (5), which is emitted by LLVM10 # and not understood by older binutils (ar, ranlib, ...) - s = modify_lines(s, lambda l: re.sub('^(.+)warning: (.+): unsupported GNU_PROPERTY_TYPE \(5\) type: 0xc000000(.*)$', '', l)) + s = modify_lines(s, lambda l: re.sub(r'^(.+)warning: (.+): unsupported GNU_PROPERTY_TYPE \(5\) type: 0xc000000(.*)$', '', l)) - s = re.sub('ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) + s = re.sub(r'ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) s = re.sub('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version','',s) # ignore superfluous dylibs passed to the linker. s = re.sub('ld: warning: .*, ignoring unexpected dylib file\n','',s) # ignore LLVM Version mismatch garbage; this will just break tests. s = re.sub('You are using an unsupported version of LLVM!.*\n','',s) - s = re.sub('Currently only [\.0-9]+ is supported. System LLVM version: [\.0-9]+.*\n','',s) - s = re.sub('We will try though\.\.\..*\n','',s) + s = re.sub('Currently only [\\.0-9]+ is supported. System LLVM version: [\\.0-9]+.*\n','',s) + s = re.sub('We will try though\\.\\.\\..*\n','',s) # ignore warning about strip invalidating signatures s = re.sub('.*strip: changes being made to the file will invalidate the code signature in.*\n','',s) # clang may warn about unused argument when used as assembler @@ -2475,8 +2475,8 @@ def normalise_slashes_( s: str ) -> str: return s def normalise_exe_( s: str ) -> str: - s = re.sub('\.exe', '', s) - s = re.sub('\.jsexe', '', s) + s = re.sub(r'\.exe', '', s) + s = re.sub(r'\.jsexe', '', s) return s def normalise_output( s: str ) -> str: @@ -2494,14 +2494,14 @@ def normalise_output( s: str ) -> str: # ghci outputs are pretty unstable with -fexternal-dynamic-refs, which is # requires for -fPIC s = re.sub(' -fexternal-dynamic-refs\n','',s) - s = re.sub('ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) + s = re.sub(r'ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) s = re.sub('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version','',s) # ignore superfluous dylibs passed to the linker. s = re.sub('ld: warning: .*, ignoring unexpected dylib file\n','',s) # ignore LLVM Version mismatch garbage; this will just break tests. s = re.sub('You are using an unsupported version of LLVM!.*\n','',s) - s = re.sub('Currently only [\.0-9]+ is supported. System LLVM version: [\.0-9]+.*\n','',s) - s = re.sub('We will try though\.\.\..*\n','',s) + s = re.sub('Currently only [\\.0-9]+ is supported. System LLVM version: [\\.0-9]+.*\n','',s) + s = re.sub('We will try though\\.\\.\\..*\n','',s) # ignore warning about strip invalidating signatures s = re.sub('.*strip: changes being made to the file will invalidate the code signature in.*\n','',s) # clang may warn about unused argument when used as assembler View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9912de75400b7006fc2eb6cb31c9bf5ae6dacd6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9912de75400b7006fc2eb6cb31c9bf5ae6dacd6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 04:45:30 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 07 Feb 2023 23:45:30 -0500 Subject: [Git][ghc/ghc][wip/T22264-9.2] 24 commits: Bump version to GHC 9.2.6 and add changelog entries Message-ID: <63e328eabf229_730ce526985692c@gitlab.mail> Ben Gamari pushed to branch wip/T22264-9.2 at Glasgow Haskell Compiler / GHC Commits: d966ed64 by Zubin Duggal at 2023-02-07T22:42:03+05:30 Bump version to GHC 9.2.6 and add changelog entries - - - - - 67ec973c by Zubin Duggal at 2023-02-08T05:42:32+05:30 Allow metric changes for 9.2.6 as baseline is from a release pipeline Metric Decrease: haddock.base haddock.Cabal haddock.compiler Metric Increase: ManyAlternatives ManyConstructors T10421 T10858 T12227 T12425 T12707 T13035 T13253 T13719 T15164 T16577 T18304 T18698a T18698b T3294 T5321FD T5642 T9203 T9233 T9630 T9872a T9872b T9872c T9872d T14697 T12545 - - - - - 0da9df62 by Zubin Duggal at 2023-02-07T23:45:21-05:00 Allow stat increases for GHC 9.2 Metric Increase: T13701 T14697 - - - - - bfade231 by Ben Gamari at 2023-02-07T23:45:21-05:00 rts: Introduce getNumCapabilities And ensure accesses to n_capabilities are atomic (although with relaxed ordering). This is necessary as RTS API callers may concurrently call into the RTS without holding a capability. (cherry picked from commit 70999283156f527c5aea6dee57a3d14989a9903a) - - - - - b11d7924 by Ben Gamari at 2023-02-07T23:45:21-05:00 nonmoving: Don't show occupancy if we didn't collect live words (cherry picked from commit fcd9794163f6ae7af8783676ee79e0b8e78167ba) - - - - - 1f829eff by Ben Gamari at 2023-02-07T23:45:21-05:00 nonmoving: Refactor update remembered set initialization This avoids a lock inversion between the storage manager mutex and the stable pointer table mutex by not dropping the SM_MUTEX in nonmovingCollect. This requires quite a bit of rejiggering but it does seem like a better strategy. (cherry picked from commit 543cae0084a72ca767a443d857f9e65a5a79f71d) - - - - - 4377ab1e by Ben Gamari at 2023-02-07T23:45:21-05:00 nonmoving: Fix style (cherry picked from commit b642ef1dc4cbe19c3479b2c014e7d1f7959f8e4a) - - - - - fcb1aff8 by Ben Gamari at 2023-02-07T23:45:22-05:00 Evac: Squash data race in eval_selector_chain (cherry picked from commit dd784b3b01f076fa7f5715150c53ad4c183ae79d) - - - - - 74abe63c by Ben Gamari at 2023-02-07T23:45:22-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Likely fixes the cause of #22264. (cherry picked from commit f8988a9c53ae73ff5b9c6008f467a7171e99c61f) - - - - - 5722a815 by Ben Gamari at 2023-02-07T23:45:22-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. (cherry picked from commit a999f7b5b4b7316c088d7233a452fb33dc17646f) - - - - - 8f978a3f by Ben Gamari at 2023-02-07T23:45:22-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. (cherry picked from commit 48b89dba91640fa977d038ea5283019c73f1b18e) - - - - - 3dcd0035 by Ben Gamari at 2023-02-07T23:45:22-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive (cherry picked from commit 36ca160d0f199a688cf5fbc91d4bb92d2d4ea14e) - - - - - 6b260418 by Ben Gamari at 2023-02-07T23:45:22-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. (cherry picked from commit 8b64aff0fa978c762dfae8df235dd2b2a340656a) - - - - - 13e71f43 by Ben Gamari at 2023-02-07T23:45:22-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. (cherry picked from commit dde67d6e32ecff0e400f98213d42ae790babac09) - - - - - cf56eaa2 by Ben Gamari at 2023-02-07T23:45:22-05:00 nonmoving: Don't push if nonmoving collector isn't enabled (cherry picked from commit 8adc1750c02e596b4014d2837b4eb3d76bd130f2) - - - - - 4cd10804 by Ben Gamari at 2023-02-07T23:45:22-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. (cherry picked from commit c620669651c52fd228af61040747dd7236c4ba2b) - - - - - 9068881e by Ben Gamari at 2023-02-07T23:45:22-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys (cherry picked from commit 3887132fcd20f0a1edfc9f7006bdbed2634e2a8d) - - - - - 8ef9e3f4 by Ben Gamari at 2023-02-07T23:45:22-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. (cherry picked from commit cc75031b4d93d4565e0428cb5910d9b9a645485b) - - - - - 6e7f342c by Ben Gamari at 2023-02-07T23:45:22-05:00 nonmoving: Add missing no-op in busy-wait loop (cherry picked from commit 9f931a8801c84b8ae473f91349e144eebc73b415) - - - - - ee75ac62 by Ben Gamari at 2023-02-07T23:45:22-05:00 nonmoving: Move current segment array into Capability (cherry picked from commit 9d245c1baec91ee79d715062b127e487456d9c9e) - - - - - ccf72da0 by Ben Gamari at 2023-02-07T23:45:22-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. (cherry picked from commit 6bdce35cdd59112a8cb4a4a3b061e854ada3ff63) - - - - - 08847150 by Ben Gamari at 2023-02-07T23:45:22-05:00 nonmoving: Fix unregisterised build (cherry picked from commit 6df2709e7215ea80d7267800e0318aee2a7c277f) - - - - - 42e3aeb8 by Ben Gamari at 2023-02-07T23:45:22-05:00 nonmoving: Avoid n_caps race (cherry picked from commit c00d6de815d4e125c1c4d8ff06549042f502f759) - - - - - 5fe2c6b2 by Ben Gamari at 2023-02-07T23:45:22-05:00 relnotes: Mention various non-moving GC fixes - - - - - 30 changed files: - configure.ac - docs/users_guide/9.2.1-notes.rst - + docs/users_guide/9.2.6-notes.rst - docs/users_guide/release-notes.rst - includes/rts/Threads.h - rts/Capability.c - rts/Capability.h - rts/Messages.h - rts/PrimOps.cmm - rts/Printer.c - rts/ProfHeap.c - rts/ProfilerReport.c - rts/ProfilerReportJson.c - rts/Profiling.c - rts/Proftimer.c - rts/RetainerProfile.c - rts/RtsAPI.c - rts/RtsStartup.c - rts/SMPClosureOps.h - rts/STM.c - rts/Schedule.c - rts/Stats.c - rts/Task.c - rts/Threads.c - rts/TraverseHeap.c - rts/eventlog/EventLog.c - rts/hooks/LongGCSync.c - rts/posix/Signals.c - rts/sm/Compact.c - rts/sm/Evac.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/65690ab8dbfb83740db2c7f9d2f9a01f4d7e82e5...5fe2c6b2cd1a88a1c0edf9dfe3377805e46cf2d8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/65690ab8dbfb83740db2c7f9d2f9a01f4d7e82e5...5fe2c6b2cd1a88a1c0edf9dfe3377805e46cf2d8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 05:14:31 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Wed, 08 Feb 2023 00:14:31 -0500 Subject: [Git][ghc/ghc][wip/js-rts-fixmes] JS RTS: use jsClosureCount for closureConstructors and cache sizes Message-ID: <63e32fb760d46_730ce5271059954@gitlab.mail> Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC Commits: 9bc6ef71 by Josh Meredith at 2023-02-08T05:14:03+00:00 JS RTS: use jsClosureCount for closureConstructors and cache sizes - - - - - 2 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -133,6 +133,7 @@ module GHC.JS.Make , clsName , dataFieldName, dataFieldNames , varName, varNames + , jsClosureCount ) where @@ -642,10 +643,13 @@ instance Fractional JExpr where -- | Cache "dXXX" field names dataFieldCache :: Array Int FastString -dataFieldCache = listArray (0,nFieldCache) (map (mkFastString . ('d':) . show) [(0::Int)..nFieldCache]) +dataFieldCache = listArray (0,jsClosureCount) (map (mkFastString . ('d':) . show) [(0::Int)..nFieldCache]) nFieldCache :: Int -nFieldCache = 16384 +nFieldCache = 128 + +jsClosureCount :: Int +jsClosureCount = 24 dataFieldName :: Int -> FastString dataFieldName i @@ -653,44 +657,44 @@ dataFieldName i | otherwise = dataFieldCache ! i dataFieldNames :: [FastString] -dataFieldNames = fmap dataFieldName [1..nFieldCache] +dataFieldNames = fmap dataFieldName [1..jsClosureCount] -- | Cache "h$dXXX" names dataCache :: Array Int FastString -dataCache = listArray (0,63) (map (mkFastString . ("h$d"++) . show) [(0::Int)..63]) +dataCache = listArray (0,jsClosureCount) (map (mkFastString . ("h$d"++) . show) [(0::Int)..nFieldCache]) dataName :: Int -> FastString dataName i - | i < 0 || i > 63 = panic "dataCacheName" (ppr i) - | otherwise = dataCache ! i + | i < 0 || i > nFieldCache = panic "dataCacheName" (ppr i) + | otherwise = dataCache ! i allocData :: Int -> JExpr allocData i = toJExpr (TxtI (dataCache ! i)) -- | Cache "h$cXXX" names clsCache :: Array Int FastString -clsCache = listArray (0,63) (map (mkFastString . ("h$c"++) . show) [(0::Int)..63]) +clsCache = listArray (0,jsClosureCount) (map (mkFastString . ("h$c"++) . show) [(0::Int)..jsClosureCount]) clsName :: Int -> FastString clsName i - | i < 0 || i > 63 = panic "clsCacheName" (ppr i) - | otherwise = clsCache ! i + | i < 0 || i > jsClosureCount = panic "clsCacheName" (ppr i) + | otherwise = clsCache ! i allocClsA :: Int -> JExpr allocClsA i = toJExpr (TxtI (clsCache ! i)) -- | Cache "xXXX" names varCache :: Array Int FastString -varCache = listArray (0,63) (map (mkFastString . ('x':) . show) [(0::Int)..63]) +varCache = listArray (0,jsClosureCount) (map (mkFastString . ('x':) . show) [(0::Int)..jsClosureCount]) varName :: Int -> Ident varName i - | i < 0 || i > 63 = panic "varCacheName" (ppr i) - | otherwise = TxtI $ varCache ! i + | i < 0 || i > jsClosureCount = panic "varCacheName" (ppr i) + | otherwise = TxtI $ varCache ! i varNames :: [Ident] -varNames = fmap varName [1..63] +varNames = fmap varName [1..jsClosureCount] -------------------------------------------------------------------------------- ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -81,8 +81,8 @@ resetResultVar r = toJExpr r |= null_ -- JIT can optimize better. closureConstructors :: StgToJSConfig -> JStat closureConstructors s = BlockStat - [ mconcat (map mkClosureCon (Nothing : map Just [0..24])) - , mconcat (map mkDataFill [1..24]) + [ mconcat (map mkClosureCon (Nothing : map Just [0..jsClosureCount])) + , mconcat (map mkDataFill [1..jsClosureCount]) ] where prof = csProf s View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9bc6ef7141d8c824d364cd481f2edd79098c7cd3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9bc6ef7141d8c824d364cd481f2edd79098c7cd3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 05:33:39 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Wed, 08 Feb 2023 00:33:39 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/js-generated-refs Message-ID: <63e334331b493_730ce5269860480@gitlab.mail> Josh Meredith pushed new branch wip/js-generated-refs at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/js-generated-refs You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 06:00:09 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 08 Feb 2023 01:00:09 -0500 Subject: [Git][ghc/ghc][wip/T22264-9.2] 5 commits: nonmoving: Move current segment array into Capability Message-ID: <63e33a69b6c61_730ce5265c6292@gitlab.mail> Ben Gamari pushed to branch wip/T22264-9.2 at Glasgow Haskell Compiler / GHC Commits: 748d0619 by Ben Gamari at 2023-02-08T00:59:59-05:00 nonmoving: Move current segment array into Capability (cherry picked from commit 9d245c1baec91ee79d715062b127e487456d9c9e) - - - - - ee09ffe1 by Ben Gamari at 2023-02-08T00:59:59-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. (cherry picked from commit 6bdce35cdd59112a8cb4a4a3b061e854ada3ff63) - - - - - 9905e5ae by Ben Gamari at 2023-02-08T00:59:59-05:00 nonmoving: Fix unregisterised build (cherry picked from commit 6df2709e7215ea80d7267800e0318aee2a7c277f) - - - - - d7bad937 by Ben Gamari at 2023-02-08T00:59:59-05:00 nonmoving: Avoid n_caps race (cherry picked from commit c00d6de815d4e125c1c4d8ff06549042f502f759) - - - - - 10e43f7d by Ben Gamari at 2023-02-08T00:59:59-05:00 relnotes: Mention various non-moving GC fixes - - - - - 13 changed files: - docs/users_guide/9.2.6-notes.rst - rts/Capability.c - rts/Capability.h - rts/Schedule.c - rts/sm/GC.c - rts/sm/NonMoving.c - rts/sm/NonMoving.h - rts/sm/NonMovingCensus.c - rts/sm/NonMovingCensus.h - rts/sm/NonMovingMark.c - rts/sm/NonMovingMark.h - rts/sm/Sanity.c - rts/sm/Storage.c Changes: ===================================== docs/users_guide/9.2.6-notes.rst ===================================== @@ -66,6 +66,23 @@ Runtime system - Truncate eventlog events with a large payload (:ghc-ticket:`20221`). +- A bug in the nonmoving garbage collector regarding the treatment of + zero-length ``SmallArray#``\ s has been fixed (:ghc-ticket:`22264`) + +- A number of bugs regarding the non-moving garbage collector's treatment of + ``Weak#`` pointers have been fixed (:ghc-ticket:`22327`) + +- A few race conditions between the non-moving collector and + ``setNumCapabilities`` which could result in undefined behavior have been + fixed (:ghc-ticket:`22926`, :ghc-ticket:`22927`) + +- The non-moving collector is now able to better schedule marking work during + the post-mark synchronization phase of collection, significantly reducing + pause times in some workloads (:ghc-ticket:`22929`). + +- Various bugs in the non-moving collector's implementation of the selector + optimisation have been fixed (:ghc-ticket:`22930`) + Build system and packaging -------------------------- ===================================== rts/Capability.c ===================================== @@ -294,6 +294,7 @@ initCapability (Capability *cap, uint32_t i) cap->saved_mut_lists = stgMallocBytes(sizeof(bdescr *) * RtsFlags.GcFlags.generations, "initCapability"); + cap->current_segments = NULL; // At this point storage manager is not initialized yet, so this will be @@ -1267,6 +1268,9 @@ freeCapability (Capability *cap) { stgFree(cap->mut_lists); stgFree(cap->saved_mut_lists); + if (cap->current_segments) { + stgFree(cap->current_segments); + } #if defined(THREADED_RTS) freeSparkPool(cap->sparks); #endif ===================================== rts/Capability.h ===================================== @@ -88,6 +88,9 @@ struct Capability_ { // The update remembered set for the non-moving collector UpdRemSet upd_rem_set; + // Array of current segments for the non-moving collector. + // Of length NONMOVING_ALLOCA_CNT. + struct NonmovingSegment **current_segments; // block for allocating pinned objects into bdescr *pinned_object_block; ===================================== rts/Schedule.c ===================================== @@ -1710,7 +1710,9 @@ scheduleDoGC (Capability **pcap, Task *task USED_IF_THREADS, stat_startGCSync(gc_threads[cap->no]); +#if defined(DEBUG) unsigned int old_n_capabilities = getNumCapabilities(); +#endif interruptAllCapabilities(); @@ -2306,7 +2308,9 @@ setNumCapabilities (uint32_t new_n_capabilities USED_IF_THREADS) moreCapabilities(n_capabilities, new_n_capabilities); // Resize and update storage manager data structures + ACQUIRE_SM_LOCK; storageAddCapabilities(n_capabilities, new_n_capabilities); + RELEASE_SM_LOCK; } } ===================================== rts/sm/GC.c ===================================== @@ -375,7 +375,8 @@ GarbageCollect (uint32_t collect_gen, static_flag == STATIC_FLAG_A ? STATIC_FLAG_B : STATIC_FLAG_A; } - if (major_gc) { + /* N.B. We currently don't unload code with the non-moving collector. */ + if (major_gc && !RtsFlags.GcFlags.useNonmoving) { unload_mark_needed = prepareUnloadCheck(); } else { unload_mark_needed = false; ===================================== rts/sm/NonMoving.c ===================================== @@ -707,10 +707,11 @@ void *nonmovingAllocate(Capability *cap, StgWord sz) // object and not moved) which is covered by allocator 9. ASSERT(log_block_size < NONMOVING_ALLOCA0 + NONMOVING_ALLOCA_CNT); - struct NonmovingAllocator *alloca = nonmovingHeap.allocators[log_block_size - NONMOVING_ALLOCA0]; + unsigned int alloca_idx = log_block_size - NONMOVING_ALLOCA0; + struct NonmovingAllocator *alloca = &nonmovingHeap.allocators[alloca_idx]; // Allocate into current segment - struct NonmovingSegment *current = alloca->current[cap->no]; + struct NonmovingSegment *current = cap->current_segments[alloca_idx]; ASSERT(current); // current is never NULL void *ret = nonmovingSegmentGetBlock_(current, log_block_size, current->next_free); ASSERT(GET_CLOSURE_TAG(ret) == 0); // check alignment @@ -743,29 +744,12 @@ void *nonmovingAllocate(Capability *cap, StgWord sz) // make it current new_current->link = NULL; SET_SEGMENT_STATE(new_current, CURRENT); - alloca->current[cap->no] = new_current; + cap->current_segments[alloca_idx] = new_current; } return ret; } -/* Allocate a nonmovingAllocator */ -static struct NonmovingAllocator *alloc_nonmoving_allocator(uint32_t n_caps) -{ - size_t allocator_sz = - sizeof(struct NonmovingAllocator) + - sizeof(void*) * n_caps; // current segment pointer for each capability - struct NonmovingAllocator *alloc = - stgMallocBytes(allocator_sz, "nonmovingInit"); - memset(alloc, 0, allocator_sz); - return alloc; -} - -static void free_nonmoving_allocator(struct NonmovingAllocator *alloc) -{ - stgFree(alloc); -} - void nonmovingInit(void) { if (! RtsFlags.GcFlags.useNonmoving) return; @@ -774,10 +758,7 @@ void nonmovingInit(void) initCondition(&concurrent_coll_finished); initMutex(&concurrent_coll_finished_lock); #endif - for (unsigned int i = 0; i < NONMOVING_ALLOCA_CNT; i++) { - nonmovingHeap.allocators[i] = alloc_nonmoving_allocator(getNumCapabilities()); - } - nonmovingMarkInitUpdRemSet(); + nonmovingMarkInit(); } // Stop any nonmoving collection in preparation for RTS shutdown. @@ -806,44 +787,24 @@ void nonmovingExit(void) closeCondition(&concurrent_coll_finished); closeMutex(&nonmoving_collection_mutex); #endif - - for (unsigned int i = 0; i < NONMOVING_ALLOCA_CNT; i++) { - free_nonmoving_allocator(nonmovingHeap.allocators[i]); - } } -/* - * Assumes that no garbage collector or mutator threads are running to safely - * resize the nonmoving_allocators. - * - * Must hold sm_mutex. - */ -void nonmovingAddCapabilities(uint32_t new_n_caps) +/* Initialize a new capability. Caller must hold SM_LOCK */ +void nonmovingInitCapability(Capability *cap) { - unsigned int old_n_caps = nonmovingHeap.n_caps; - struct NonmovingAllocator **allocs = nonmovingHeap.allocators; - + // Initialize current segment array + struct NonmovingSegment **segs = + stgMallocBytes(sizeof(struct NonmovingSegment*) * NONMOVING_ALLOCA_CNT, "current segment array"); for (unsigned int i = 0; i < NONMOVING_ALLOCA_CNT; i++) { - struct NonmovingAllocator *old = allocs[i]; - allocs[i] = alloc_nonmoving_allocator(new_n_caps); - - // Copy the old state - allocs[i]->filled = old->filled; - allocs[i]->active = old->active; - for (unsigned int j = 0; j < old_n_caps; j++) { - allocs[i]->current[j] = old->current[j]; - } - stgFree(old); - - // Initialize current segments for the new capabilities - for (unsigned int j = old_n_caps; j < new_n_caps; j++) { - allocs[i]->current[j] = nonmovingAllocSegment(capabilities[j]->node); - nonmovingInitSegment(allocs[i]->current[j], NONMOVING_ALLOCA0 + i); - SET_SEGMENT_STATE(allocs[i]->current[j], CURRENT); - allocs[i]->current[j]->link = NULL; - } + segs[i] = nonmovingAllocSegment(cap->node); + nonmovingInitSegment(segs[i], NONMOVING_ALLOCA0 + i); + SET_SEGMENT_STATE(segs[i], CURRENT); } - nonmovingHeap.n_caps = new_n_caps; + cap->current_segments = segs; + + // Initialize update remembered set + cap->upd_rem_set.queue.blocks = NULL; + nonmovingInitUpdRemSet(&cap->upd_rem_set); } void nonmovingClearBitmap(struct NonmovingSegment *seg) @@ -863,13 +824,15 @@ static void nonmovingPrepareMark(void) // Should have been cleared by the last sweep ASSERT(nonmovingHeap.sweep_list == NULL); + nonmovingHeap.n_caps = n_capabilities; nonmovingBumpEpoch(); for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { - struct NonmovingAllocator *alloca = nonmovingHeap.allocators[alloca_idx]; + struct NonmovingAllocator *alloca = &nonmovingHeap.allocators[alloca_idx]; // Update current segments' snapshot pointers - for (uint32_t cap_n = 0; cap_n < getNumCapabilities(); ++cap_n) { - struct NonmovingSegment *seg = alloca->current[cap_n]; + for (uint32_t cap_n = 0; cap_n < nonmovingHeap.n_caps; ++cap_n) { + Capability *cap = capabilities[cap_n]; + struct NonmovingSegment *seg = cap->current_segments[alloca_idx]; nonmovingSegmentInfo(seg)->next_free_snap = seg->next_free; } @@ -1101,7 +1064,7 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * // Walk the list of filled segments that we collected during preparation, // updated their snapshot pointers and move them to the sweep list. for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { - struct NonmovingSegment *filled = nonmovingHeap.allocators[alloca_idx]->saved_filled; + struct NonmovingSegment *filled = nonmovingHeap.allocators[alloca_idx].saved_filled; uint32_t n_filled = 0; if (filled) { struct NonmovingSegment *seg = filled; @@ -1120,7 +1083,7 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * seg->link = nonmovingHeap.sweep_list; nonmovingHeap.sweep_list = filled; } - nonmovingHeap.allocators[alloca_idx]->saved_filled = NULL; + nonmovingHeap.allocators[alloca_idx].saved_filled = NULL; } // Mark Weak#s @@ -1329,10 +1292,12 @@ void assert_in_nonmoving_heap(StgPtr p) } for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { - struct NonmovingAllocator *alloca = nonmovingHeap.allocators[alloca_idx]; + struct NonmovingAllocator *alloca = &nonmovingHeap.allocators[alloca_idx]; + // Search current segments - for (uint32_t cap_idx = 0; cap_idx < getNumCapabilities(); ++cap_idx) { - struct NonmovingSegment *seg = alloca->current[cap_idx]; + for (uint32_t cap_idx = 0; cap_idx < nonmovingHeap.n_caps; ++cap_idx) { + Capability *cap = capabilities[cap_idx]; + struct NonmovingSegment *seg = cap->current_segments[alloca_idx]; if (p >= (P_)seg && p < (((P_)seg) + NONMOVING_SEGMENT_SIZE_W)) { return; } @@ -1391,33 +1356,16 @@ void nonmovingPrintSegment(struct NonmovingSegment *seg) debugBelch("End of segment\n\n"); } -void nonmovingPrintAllocator(struct NonmovingAllocator *alloc) -{ - debugBelch("Allocator at %p\n", (void*)alloc); - debugBelch("Filled segments:\n"); - for (struct NonmovingSegment *seg = alloc->filled; seg != NULL; seg = seg->link) { - debugBelch("%p ", (void*)seg); - } - debugBelch("\nActive segments:\n"); - for (struct NonmovingSegment *seg = alloc->active; seg != NULL; seg = seg->link) { - debugBelch("%p ", (void*)seg); - } - debugBelch("\nCurrent segments:\n"); - for (uint32_t i = 0; i < getNumCapabilities(); ++i) { - debugBelch("%p ", alloc->current[i]); - } - debugBelch("\n"); -} - void locate_object(P_ obj) { // Search allocators for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { - struct NonmovingAllocator *alloca = nonmovingHeap.allocators[alloca_idx]; - for (uint32_t cap = 0; cap < getNumCapabilities(); ++cap) { - struct NonmovingSegment *seg = alloca->current[cap]; + struct NonmovingAllocator *alloca = &nonmovingHeap.allocators[alloca_idx]; + for (uint32_t cap_n = 0; cap_n < nonmovingHeap.n_caps; ++cap_n) { + Capability *cap = capabilities[cap_n]; + struct NonmovingSegment *seg = cap->current_segments[alloca_idx]; if (obj >= (P_)seg && obj < (((P_)seg) + NONMOVING_SEGMENT_SIZE_W)) { - debugBelch("%p is in current segment of capability %d of allocator %d at %p\n", obj, cap, alloca_idx, (void*)seg); + debugBelch("%p is in current segment of capability %d of allocator %d at %p\n", obj, cap_n, alloca_idx, (void*)seg); return; } } ===================================== rts/sm/NonMoving.h ===================================== @@ -84,8 +84,7 @@ struct NonmovingAllocator { struct NonmovingSegment *filled; struct NonmovingSegment *saved_filled; struct NonmovingSegment *active; - // indexed by capability number - struct NonmovingSegment *current[]; + // N.B. Per-capabilty "current" segment lives in Capability }; // first allocator is of size 2^NONMOVING_ALLOCA0 (in bytes) @@ -99,7 +98,7 @@ struct NonmovingAllocator { #define NONMOVING_MAX_FREE 16 struct NonmovingHeap { - struct NonmovingAllocator *allocators[NONMOVING_ALLOCA_CNT]; + struct NonmovingAllocator allocators[NONMOVING_ALLOCA_CNT]; // free segment list. This is a cache where we keep up to // NONMOVING_MAX_FREE segments to avoid thrashing the block allocator. // Note that segments in this list are still counted towards @@ -149,7 +148,7 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads); void *nonmovingAllocate(Capability *cap, StgWord sz); -void nonmovingAddCapabilities(uint32_t new_n_caps); +void nonmovingInitCapability(Capability *cap); void nonmovingPushFreeSegment(struct NonmovingSegment *seg); void nonmovingClearBitmap(struct NonmovingSegment *seg); @@ -166,7 +165,7 @@ INLINE_HEADER uint8_t nonmovingSegmentLogBlockSize(struct NonmovingSegment *seg) INLINE_HEADER void nonmovingPushActiveSegment(struct NonmovingSegment *seg) { struct NonmovingAllocator *alloc = - nonmovingHeap.allocators[nonmovingSegmentLogBlockSize(seg) - NONMOVING_ALLOCA0]; + &nonmovingHeap.allocators[nonmovingSegmentLogBlockSize(seg) - NONMOVING_ALLOCA0]; SET_SEGMENT_STATE(seg, ACTIVE); while (true) { struct NonmovingSegment *current_active = (struct NonmovingSegment*)VOLATILE_LOAD(&alloc->active); @@ -181,7 +180,7 @@ INLINE_HEADER void nonmovingPushActiveSegment(struct NonmovingSegment *seg) INLINE_HEADER void nonmovingPushFilledSegment(struct NonmovingSegment *seg) { struct NonmovingAllocator *alloc = - nonmovingHeap.allocators[nonmovingSegmentLogBlockSize(seg) - NONMOVING_ALLOCA0]; + &nonmovingHeap.allocators[nonmovingSegmentLogBlockSize(seg) - NONMOVING_ALLOCA0]; SET_SEGMENT_STATE(seg, FILLED); while (true) { struct NonmovingSegment *current_filled = (struct NonmovingSegment*)VOLATILE_LOAD(&alloc->filled); @@ -333,10 +332,14 @@ INLINE_HEADER bool nonmovingClosureBeingSwept(StgClosure *p) } } +// N.B. RtsFlags is defined as a pointer in STG code consequently this code +// doesn't typecheck. +#if !IN_STG_CODE INLINE_HEADER bool isNonmovingClosure(StgClosure *p) { return RtsFlags.GcFlags.useNonmoving && (!HEAP_ALLOCED_GC(p) || Bdescr((P_)p)->flags & BF_NONMOVING); } +#endif #if defined(DEBUG) ===================================== rts/sm/NonMovingCensus.c ===================================== @@ -21,10 +21,12 @@ // stopped. In this case is safe to look at active and current segments so we can // also collect statistics on live words. static struct NonmovingAllocCensus -nonmovingAllocatorCensus_(struct NonmovingAllocator *alloc, bool collect_live_words) +nonmovingAllocatorCensus_(uint32_t alloc_idx, bool collect_live_words) { struct NonmovingAllocCensus census = {collect_live_words, 0, 0, 0, 0}; + struct NonmovingAllocator *alloc = &nonmovingHeap.allocators[alloc_idx]; + // filled segments for (struct NonmovingSegment *seg = alloc->filled; seg != NULL; seg = seg->link) @@ -40,6 +42,7 @@ nonmovingAllocatorCensus_(struct NonmovingAllocator *alloc, bool collect_live_wo } } + // active segments for (struct NonmovingSegment *seg = alloc->active; seg != NULL; seg = seg->link) @@ -56,9 +59,11 @@ nonmovingAllocatorCensus_(struct NonmovingAllocator *alloc, bool collect_live_wo } } - for (unsigned int cap=0; cap < getNumCapabilities(); cap++) + // current segments + for (unsigned int cap_n=0; cap_n < getNumCapabilities(); cap_n++) { - struct NonmovingSegment *seg = alloc->current[cap]; + Capability *cap = capabilities[cap_n]; + struct NonmovingSegment *seg = cap->current_segments[alloc_idx]; unsigned int n = nonmovingSegmentBlockCount(seg); for (unsigned int i=0; i < n; i++) { if (nonmovingGetMark(seg, i)) { @@ -76,15 +81,15 @@ nonmovingAllocatorCensus_(struct NonmovingAllocator *alloc, bool collect_live_wo * all blocks in nonmoving heap are valid closures. */ struct NonmovingAllocCensus -nonmovingAllocatorCensusWithWords(struct NonmovingAllocator *alloc) +nonmovingAllocatorCensusWithWords(uint32_t alloc_idx) { - return nonmovingAllocatorCensus_(alloc, true); + return nonmovingAllocatorCensus_(alloc_idx, true); } struct NonmovingAllocCensus -nonmovingAllocatorCensus(struct NonmovingAllocator *alloc) +nonmovingAllocatorCensus(uint32_t alloc_idx) { - return nonmovingAllocatorCensus_(alloc, false); + return nonmovingAllocatorCensus_(alloc_idx, false); } @@ -130,7 +135,7 @@ void nonmovingPrintAllocatorCensus(bool collect_live_words) for (int i=0; i < NONMOVING_ALLOCA_CNT; i++) { struct NonmovingAllocCensus census = - nonmovingAllocatorCensus_(nonmovingHeap.allocators[i], collect_live_words); + nonmovingAllocatorCensus_(i, collect_live_words); print_alloc_census(i, census); } @@ -143,8 +148,7 @@ void nonmovingTraceAllocatorCensus() return; for (int i=0; i < NONMOVING_ALLOCA_CNT; i++) { - const struct NonmovingAllocCensus census = - nonmovingAllocatorCensus(nonmovingHeap.allocators[i]); + const struct NonmovingAllocCensus census = nonmovingAllocatorCensus(i); const uint32_t log_blk_size = i + NONMOVING_ALLOCA0; traceNonmovingHeapCensus(log_blk_size, &census); } ===================================== rts/sm/NonMovingCensus.h ===================================== @@ -20,10 +20,10 @@ struct NonmovingAllocCensus { struct NonmovingAllocCensus -nonmovingAllocatorCensusWithWords(struct NonmovingAllocator *alloc); +nonmovingAllocatorCensusWithWords(uint32_t alloc_idx); struct NonmovingAllocCensus -nonmovingAllocatorCensus(struct NonmovingAllocator *alloc); +nonmovingAllocatorCensus(uint32_t alloc_idx); void nonmovingPrintAllocatorCensus(bool collect_live_words); void nonmovingTraceAllocatorCensus(void); ===================================== rts/sm/NonMovingMark.c ===================================== @@ -257,7 +257,7 @@ StgWord nonmoving_write_barrier_enabled = false; MarkQueue *current_mark_queue = NULL; /* Initialise update remembered set data structures */ -void nonmovingMarkInitUpdRemSet() { +void nonmovingMarkInit() { #if defined(THREADED_RTS) initMutex(&upd_rem_set_lock); initCondition(&upd_rem_set_flushed_cond); @@ -301,8 +301,8 @@ static void nonmovingAddUpdRemSetBlocks_lock(MarkQueue *rset) // Reset the state of the remembered set. ACQUIRE_SM_LOCK; init_mark_queue_(rset); - rset->is_upd_rem_set = true; RELEASE_SM_LOCK; + rset->is_upd_rem_set = true; } /* ===================================== rts/sm/NonMovingMark.h ===================================== @@ -140,7 +140,7 @@ extern MarkQueue *current_mark_queue; extern bdescr *upd_rem_set_block_list; -void nonmovingMarkInitUpdRemSet(void); +void nonmovingMarkInit(void); void nonmovingInitUpdRemSet(UpdRemSet *rset); void updateRemembSetPushClosure(Capability *cap, StgClosure *p); ===================================== rts/sm/Sanity.c ===================================== @@ -619,11 +619,12 @@ static void checkNonmovingSegments (struct NonmovingSegment *seg) void checkNonmovingHeap (const struct NonmovingHeap *heap) { for (unsigned int i=0; i < NONMOVING_ALLOCA_CNT; i++) { - const struct NonmovingAllocator *alloc = heap->allocators[i]; + const struct NonmovingAllocator *alloc = &heap->allocators[i]; checkNonmovingSegments(alloc->filled); checkNonmovingSegments(alloc->active); - for (unsigned int cap=0; cap < getNumCapabilities(); cap++) { - checkNonmovingSegments(alloc->current[cap]); + for (unsigned int cap_n=0; cap_n < getNumCapabilities(); cap_n++) { + Capability *cap = capabilities[cap_n]; + checkNonmovingSegments(cap->current_segments[i]); } } } @@ -1047,11 +1048,12 @@ findMemoryLeak (void) markBlocks(nonmoving_compact_objects); markBlocks(nonmoving_marked_compact_objects); for (i = 0; i < NONMOVING_ALLOCA_CNT; i++) { - struct NonmovingAllocator *alloc = nonmovingHeap.allocators[i]; + struct NonmovingAllocator *alloc = &nonmovingHeap.allocators[i]; markNonMovingSegments(alloc->filled); markNonMovingSegments(alloc->active); for (j = 0; j < getNumCapabilities(); j++) { - markNonMovingSegments(alloc->current[j]); + Capability *cap = capabilities[j]; + markNonMovingSegments(cap->current_segments[i]); } } markNonMovingSegments(nonmovingHeap.sweep_list); @@ -1156,23 +1158,18 @@ countNonMovingSegments(struct NonmovingSegment *segs) return ret; } -static W_ -countNonMovingAllocator(struct NonmovingAllocator *alloc) -{ - W_ ret = countNonMovingSegments(alloc->filled) - + countNonMovingSegments(alloc->active); - for (uint32_t i = 0; i < getNumCapabilities(); ++i) { - ret += countNonMovingSegments(alloc->current[i]); - } - return ret; -} - static W_ countNonMovingHeap(struct NonmovingHeap *heap) { W_ ret = 0; for (int alloc_idx = 0; alloc_idx < NONMOVING_ALLOCA_CNT; alloc_idx++) { - ret += countNonMovingAllocator(heap->allocators[alloc_idx]); + struct NonmovingAllocator *alloc = &heap->allocators[alloc_idx]; + ret += countNonMovingSegments(alloc->filled); + ret += countNonMovingSegments(alloc->active); + for (uint32_t c = 0; c < getNumCapabilities(); ++c) { + Capability *cap = capabilities[c]; + ret += countNonMovingSegments(cap->current_segments[alloc_idx]); + } } ret += countNonMovingSegments(heap->sweep_list); ret += countNonMovingSegments(heap->free); ===================================== rts/sm/Storage.c ===================================== @@ -214,17 +214,14 @@ initStorage (void) } oldest_gen->to = oldest_gen; - // Nonmoving heap uses oldest_gen so initialize it after initializing oldest_gen - nonmovingInit(); - #if defined(THREADED_RTS) // nonmovingAddCapabilities allocates segments, which requires taking the gc // sync lock, so initialize it before nonmovingAddCapabilities initSpinLock(&gc_alloc_block_sync); #endif - if (RtsFlags.GcFlags.useNonmoving) - nonmovingAddCapabilities(getNumCapabilities()); + // Nonmoving heap uses oldest_gen so initialize it after initializing oldest_gen + nonmovingInit(); /* The oldest generation has one step. */ if (RtsFlags.GcFlags.compact || RtsFlags.GcFlags.sweep) { @@ -320,12 +317,10 @@ void storageAddCapabilities (uint32_t from, uint32_t to) } } - // Initialize NonmovingAllocators and UpdRemSets + // Initialize non-moving collector if (RtsFlags.GcFlags.useNonmoving) { - nonmovingAddCapabilities(to); - for (i = from; i < to; ++i) { - capabilities[i]->upd_rem_set.queue.blocks = NULL; - nonmovingInitUpdRemSet(&capabilities[i]->upd_rem_set); + for (i = from; i < to; i++) { + nonmovingInitCapability(capabilities[i]); } } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5fe2c6b2cd1a88a1c0edf9dfe3377805e46cf2d8...10e43f7d3f31badae0bd11d12ec145840d9b259b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5fe2c6b2cd1a88a1c0edf9dfe3377805e46cf2d8...10e43f7d3f31badae0bd11d12ec145840d9b259b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 06:59:41 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 08 Feb 2023 01:59:41 -0500 Subject: [Git][ghc/ghc] Deleted branch wip/backports-9.6 Message-ID: <63e3485d68068_730ce44cba7c65926@gitlab.mail> Ben Gamari deleted branch wip/backports-9.6 at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 06:59:43 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 08 Feb 2023 01:59:43 -0500 Subject: [Git][ghc/ghc][ghc-9.6] 12 commits: Disable unfolding sharing for interface files with core definitions Message-ID: <63e3485f579e0_730ce5265c661db@gitlab.mail> Ben Gamari pushed to branch ghc-9.6 at Glasgow Haskell Compiler / GHC Commits: cbd60c81 by Matthew Pickering at 2023-02-07T19:27:16-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 (cherry picked from commit 0ada454703560b733fe3c920b87496ac1238c29e) - - - - - 18942043 by Bodigrim at 2023-02-07T19:27:23-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec (cherry picked from commit 3135819847aae0cdcc6c2fca4a2234fcfed1db93) - - - - - 86698692 by Andreas Klebinger at 2023-02-07T19:27:30-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. (cherry picked from commit bf3f88a1a5b23bdf304baca473c3ee797c5f86bd) - - - - - c6c96a3a by Ben Gamari at 2023-02-07T19:27:36-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) (cherry picked from commit 25537dfda4ae59bc0321b229ca9ff924ef64d1fa) - - - - - 51397a53 by Bodigrim at 2023-02-07T19:27:42-05:00 Fix colors in emacs terminal (cherry picked from commit 5a54ac0b2b915889950c83e04bf1beb08631891e) - - - - - 2c7f85fe by Ryan Scott at 2023-02-07T19:27:58-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` (cherry picked from commit de1d15127ac3f41ac3044215b0ea3398a36edc89) - - - - - 81873448 by Tamar Christina at 2023-02-07T19:27:59-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. (cherry picked from commit 48e391952c17ff7eab10b0b1456e3f2a2af28a9b) - - - - - 18d1c5f9 by Ben Gamari at 2023-02-07T19:29:38-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. (cherry picked from commit b2bb3e62275cc1d9e00a2d5ed511843192133ed5) - - - - - 2ec1c359 by Luite Stegeman at 2023-02-07T19:29:54-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 (cherry picked from commit 77a8234c5d284846e18c0a44ba5ee196059aaea6) - - - - - 8ab4d956 by sheaf at 2023-02-07T19:30:16-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 (cherry picked from commit b17fb3d96bd2e9f3bf96392f3b3b3e0aed7fe276) - - - - - dce53f5c by Ben Gamari at 2023-02-07T19:30:22-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) (cherry picked from commit 929161943f19e1673288adc83d165ddc99865798) - - - - - bafa3899 by Sylvain Henry at 2023-02-07T19:37:15-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> (cherry picked from commit 6636b670233522f01d002c9b97827d00289dbf5c) - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/SysTools/Terminal.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Types/CostCentre.hs - config.sub - configure.ac - docs/users_guide/9.6.1-notes.rst - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Packages.hs - libraries/base/Control/Concurrent.hs - libraries/base/GHC/Conc/IO.hs - libraries/base/GHC/Conc/Windows.hs - libraries/base/GHC/Event.hs - libraries/base/GHC/Event/Thread.hs - libraries/base/GHC/Event/TimerManager.hs - libraries/base/GHC/IO/Encoding.hs - libraries/base/GHC/IO/Encoding/CodePage/API.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/30d3c8271b867ff9d6c2514632632b9483a09056...bafa389975872e1dec6925e05ee0efc349656110 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/30d3c8271b867ff9d6c2514632632b9483a09056...bafa389975872e1dec6925e05ee0efc349656110 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 07:54:23 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Wed, 08 Feb 2023 02:54:23 -0500 Subject: [Git][ghc/ghc][wip/js-rts-fixmes] JS RTS: use jsClosureCount for closureConstructors and cache sizes Message-ID: <63e3552f630b1_730ce5260c68951@gitlab.mail> Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC Commits: 1ab45575 by Josh Meredith at 2023-02-08T07:54:08+00:00 JS RTS: use jsClosureCount for closureConstructors and cache sizes - - - - - 2 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -133,6 +133,7 @@ module GHC.JS.Make , clsName , dataFieldName, dataFieldNames , varName, varNames + , jsClosureCount ) where @@ -642,10 +643,13 @@ instance Fractional JExpr where -- | Cache "dXXX" field names dataFieldCache :: Array Int FastString -dataFieldCache = listArray (0,nFieldCache) (map (mkFastString . ('d':) . show) [(0::Int)..nFieldCache]) +dataFieldCache = listArray (0,jsClosureCount) (map (mkFastString . ('d':) . show) [(0::Int)..nFieldCache]) nFieldCache :: Int -nFieldCache = 16384 +nFieldCache = 128 + +jsClosureCount :: Int +jsClosureCount = 24 dataFieldName :: Int -> FastString dataFieldName i @@ -653,44 +657,44 @@ dataFieldName i | otherwise = dataFieldCache ! i dataFieldNames :: [FastString] -dataFieldNames = fmap dataFieldName [1..nFieldCache] +dataFieldNames = fmap dataFieldName [1..jsClosureCount] -- | Cache "h$dXXX" names dataCache :: Array Int FastString -dataCache = listArray (0,63) (map (mkFastString . ("h$d"++) . show) [(0::Int)..63]) +dataCache = listArray (0,jsClosureCount) (map (mkFastString . ("h$d"++) . show) [(0::Int)..nFieldCache]) dataName :: Int -> FastString dataName i - | i < 0 || i > 63 = panic "dataCacheName" (ppr i) - | otherwise = dataCache ! i + | i < 0 || i > nFieldCache = panic "dataCacheName" (ppr i) + | otherwise = dataCache ! i allocData :: Int -> JExpr allocData i = toJExpr (TxtI (dataCache ! i)) -- | Cache "h$cXXX" names clsCache :: Array Int FastString -clsCache = listArray (0,63) (map (mkFastString . ("h$c"++) . show) [(0::Int)..63]) +clsCache = listArray (0,jsClosureCount) (map (mkFastString . ("h$c"++) . show) [(0::Int)..nFieldCache]) clsName :: Int -> FastString clsName i - | i < 0 || i > 63 = panic "clsCacheName" (ppr i) - | otherwise = clsCache ! i + | i < 0 || i > jsClosureCount = panic "clsCacheName" (ppr i) + | otherwise = clsCache ! i allocClsA :: Int -> JExpr allocClsA i = toJExpr (TxtI (clsCache ! i)) -- | Cache "xXXX" names varCache :: Array Int FastString -varCache = listArray (0,63) (map (mkFastString . ('x':) . show) [(0::Int)..63]) +varCache = listArray (0,jsClosureCount) (map (mkFastString . ('x':) . show) [(0::Int)..jsClosureCount]) varName :: Int -> Ident varName i - | i < 0 || i > 63 = panic "varCacheName" (ppr i) - | otherwise = TxtI $ varCache ! i + | i < 0 || i > jsClosureCount = panic "varCacheName" (ppr i) + | otherwise = TxtI $ varCache ! i varNames :: [Ident] -varNames = fmap varName [1..63] +varNames = fmap varName [1..jsClosureCount] -------------------------------------------------------------------------------- ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -81,8 +81,8 @@ resetResultVar r = toJExpr r |= null_ -- JIT can optimize better. closureConstructors :: StgToJSConfig -> JStat closureConstructors s = BlockStat - [ mconcat (map mkClosureCon (Nothing : map Just [0..24])) - , mconcat (map mkDataFill [1..24]) + [ mconcat (map mkClosureCon (Nothing : map Just [0..jsClosureCount])) + , mconcat (map mkDataFill [1..jsClosureCount]) ] where prof = csProf s View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ab4557552c04b092896b92a1c787d118effdffe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ab4557552c04b092896b92a1c787d118effdffe You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 09:27:26 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Wed, 08 Feb 2023 04:27:26 -0500 Subject: [Git][ghc/ghc][wip/9.2.6-backports] 21 commits: rts: Introduce getNumCapabilities Message-ID: <63e36afe65c58_730ce52724934a9@gitlab.mail> Zubin pushed to branch wip/9.2.6-backports at Glasgow Haskell Compiler / GHC Commits: 804cd4c7 by Ben Gamari at 2023-02-08T14:54:08+05:30 rts: Introduce getNumCapabilities And ensure accesses to n_capabilities are atomic (although with relaxed ordering). This is necessary as RTS API callers may concurrently call into the RTS without holding a capability. (cherry picked from commit 70999283156f527c5aea6dee57a3d14989a9903a) - - - - - 04e9ae57 by Ben Gamari at 2023-02-08T14:54:16+05:30 nonmoving: Don't show occupancy if we didn't collect live words (cherry picked from commit fcd9794163f6ae7af8783676ee79e0b8e78167ba) - - - - - 67b43a14 by Ben Gamari at 2023-02-08T14:54:22+05:30 nonmoving: Refactor update remembered set initialization This avoids a lock inversion between the storage manager mutex and the stable pointer table mutex by not dropping the SM_MUTEX in nonmovingCollect. This requires quite a bit of rejiggering but it does seem like a better strategy. (cherry picked from commit 543cae0084a72ca767a443d857f9e65a5a79f71d) - - - - - 0c85bf30 by Ben Gamari at 2023-02-08T14:54:29+05:30 nonmoving: Fix style (cherry picked from commit b642ef1dc4cbe19c3479b2c014e7d1f7959f8e4a) - - - - - 3d26addf by Ben Gamari at 2023-02-08T14:54:43+05:30 Evac: Squash data race in eval_selector_chain (cherry picked from commit dd784b3b01f076fa7f5715150c53ad4c183ae79d) - - - - - 1c4ce072 by Ben Gamari at 2023-02-08T14:54:52+05:30 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Likely fixes the cause of #22264. (cherry picked from commit f8988a9c53ae73ff5b9c6008f467a7171e99c61f) - - - - - 90dbc9e8 by Ben Gamari at 2023-02-08T14:55:02+05:30 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. (cherry picked from commit a999f7b5b4b7316c088d7233a452fb33dc17646f) - - - - - 6e9c60cc by Ben Gamari at 2023-02-08T14:55:09+05:30 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. (cherry picked from commit 48b89dba91640fa977d038ea5283019c73f1b18e) - - - - - 20591cb0 by Ben Gamari at 2023-02-08T14:55:21+05:30 nonmoving: Handle new closures in nonmovingIsNowAlive (cherry picked from commit 36ca160d0f199a688cf5fbc91d4bb92d2d4ea14e) - - - - - 03f575a3 by Ben Gamari at 2023-02-08T14:55:27+05:30 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. (cherry picked from commit 8b64aff0fa978c762dfae8df235dd2b2a340656a) - - - - - fe9cec4c by Ben Gamari at 2023-02-08T14:55:34+05:30 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. (cherry picked from commit dde67d6e32ecff0e400f98213d42ae790babac09) - - - - - 20727b6a by Ben Gamari at 2023-02-08T14:55:41+05:30 nonmoving: Don't push if nonmoving collector isn't enabled (cherry picked from commit 8adc1750c02e596b4014d2837b4eb3d76bd130f2) - - - - - f3866802 by Ben Gamari at 2023-02-08T14:56:15+05:30 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. (cherry picked from commit c620669651c52fd228af61040747dd7236c4ba2b) - - - - - 0bb408be by Ben Gamari at 2023-02-08T14:56:23+05:30 nonmoving: Allow pinned gen0 objects to be WEAK keys (cherry picked from commit 3887132fcd20f0a1edfc9f7006bdbed2634e2a8d) - - - - - ab2f238f by Ben Gamari at 2023-02-08T14:56:29+05:30 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. (cherry picked from commit cc75031b4d93d4565e0428cb5910d9b9a645485b) - - - - - ce7573df by Ben Gamari at 2023-02-08T14:56:36+05:30 nonmoving: Add missing no-op in busy-wait loop (cherry picked from commit 9f931a8801c84b8ae473f91349e144eebc73b415) - - - - - fb3b83b4 by Ben Gamari at 2023-02-08T14:56:43+05:30 nonmoving: Move current segment array into Capability (cherry picked from commit 9d245c1baec91ee79d715062b127e487456d9c9e) - - - - - 3003bf06 by Ben Gamari at 2023-02-08T14:56:50+05:30 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. (cherry picked from commit 6bdce35cdd59112a8cb4a4a3b061e854ada3ff63) - - - - - f68e52df by Ben Gamari at 2023-02-08T14:56:56+05:30 nonmoving: Fix unregisterised build (cherry picked from commit 6df2709e7215ea80d7267800e0318aee2a7c277f) - - - - - 2cc446ff by Ben Gamari at 2023-02-08T14:57:03+05:30 nonmoving: Avoid n_caps race (cherry picked from commit c00d6de815d4e125c1c4d8ff06549042f502f759) - - - - - df5d85dc by Ben Gamari at 2023-02-08T14:57:11+05:30 relnotes: Mention various non-moving GC fixes - - - - - 30 changed files: - docs/users_guide/9.2.6-notes.rst - includes/rts/Threads.h - rts/Capability.c - rts/Capability.h - rts/Messages.h - rts/PrimOps.cmm - rts/Printer.c - rts/ProfHeap.c - rts/ProfilerReport.c - rts/ProfilerReportJson.c - rts/Profiling.c - rts/Proftimer.c - rts/RetainerProfile.c - rts/RtsAPI.c - rts/RtsStartup.c - rts/SMPClosureOps.h - rts/STM.c - rts/Schedule.c - rts/Stats.c - rts/Task.c - rts/Threads.c - rts/TraverseHeap.c - rts/eventlog/EventLog.c - rts/hooks/LongGCSync.c - rts/posix/Signals.c - rts/sm/Compact.c - rts/sm/Evac.c - rts/sm/GC.c - rts/sm/MarkWeak.c - rts/sm/NonMoving.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/67ec973ce40d8a66d48c0f5f40458380957b6e6f...df5d85dc201a6d66e6272abda448ebdff67dd6a2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/67ec973ce40d8a66d48c0f5f40458380957b6e6f...df5d85dc201a6d66e6272abda448ebdff67dd6a2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 10:15:44 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Wed, 08 Feb 2023 05:15:44 -0500 Subject: [Git][ghc/ghc][wip/js-rts-fixmes] JS RTS: use jsClosureCount for closureConstructors and cache sizes Message-ID: <63e3765074f98_730ce5269810003b@gitlab.mail> Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC Commits: 1496d749 by Josh Meredith at 2023-02-08T10:15:25+00:00 JS RTS: use jsClosureCount for closureConstructors and cache sizes - - - - - 2 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -133,6 +133,7 @@ module GHC.JS.Make , clsName , dataFieldName, dataFieldNames , varName, varNames + , jsClosureCount ) where @@ -642,10 +643,13 @@ instance Fractional JExpr where -- | Cache "dXXX" field names dataFieldCache :: Array Int FastString -dataFieldCache = listArray (0,nFieldCache) (map (mkFastString . ('d':) . show) [(0::Int)..nFieldCache]) +dataFieldCache = listArray (0,jsClosureCount) (map (mkFastString . ('d':) . show) [(0::Int)..nFieldCache]) nFieldCache :: Int -nFieldCache = 16384 +nFieldCache = 128 + +jsClosureCount :: Int +jsClosureCount = 24 dataFieldName :: Int -> FastString dataFieldName i @@ -653,44 +657,44 @@ dataFieldName i | otherwise = dataFieldCache ! i dataFieldNames :: [FastString] -dataFieldNames = fmap dataFieldName [1..nFieldCache] +dataFieldNames = fmap dataFieldName [1..jsClosureCount] -- | Cache "h$dXXX" names dataCache :: Array Int FastString -dataCache = listArray (0,63) (map (mkFastString . ("h$d"++) . show) [(0::Int)..63]) +dataCache = listArray (0,nFieldCache) (map (mkFastString . ("h$d"++) . show) [(0::Int)..nFieldCache]) dataName :: Int -> FastString dataName i - | i < 0 || i > 63 = panic "dataCacheName" (ppr i) - | otherwise = dataCache ! i + | i < 0 || i > nFieldCache = panic "dataCacheName" (ppr i) + | otherwise = dataCache ! i allocData :: Int -> JExpr allocData i = toJExpr (TxtI (dataCache ! i)) -- | Cache "h$cXXX" names clsCache :: Array Int FastString -clsCache = listArray (0,63) (map (mkFastString . ("h$c"++) . show) [(0::Int)..63]) +clsCache = listArray (0,jsClosureCount) (map (mkFastString . ("h$c"++) . show) [(0::Int)..jsClosureCount]) clsName :: Int -> FastString clsName i - | i < 0 || i > 63 = panic "clsCacheName" (ppr i) - | otherwise = clsCache ! i + | i < 0 || i > jsClosureCount = panic "clsCacheName" (ppr i) + | otherwise = clsCache ! i allocClsA :: Int -> JExpr allocClsA i = toJExpr (TxtI (clsCache ! i)) -- | Cache "xXXX" names varCache :: Array Int FastString -varCache = listArray (0,63) (map (mkFastString . ('x':) . show) [(0::Int)..63]) +varCache = listArray (0,jsClosureCount) (map (mkFastString . ('x':) . show) [(0::Int)..jsClosureCount]) varName :: Int -> Ident varName i - | i < 0 || i > 63 = panic "varCacheName" (ppr i) - | otherwise = TxtI $ varCache ! i + | i < 0 || i > jsClosureCount = panic "varCacheName" (ppr i) + | otherwise = TxtI $ varCache ! i varNames :: [Ident] -varNames = fmap varName [1..63] +varNames = fmap varName [1..jsClosureCount] -------------------------------------------------------------------------------- ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -81,8 +81,8 @@ resetResultVar r = toJExpr r |= null_ -- JIT can optimize better. closureConstructors :: StgToJSConfig -> JStat closureConstructors s = BlockStat - [ mconcat (map mkClosureCon (Nothing : map Just [0..24])) - , mconcat (map mkDataFill [1..24]) + [ mconcat (map mkClosureCon (Nothing : map Just [0..jsClosureCount])) + , mconcat (map mkDataFill [1..jsClosureCount]) ] where prof = csProf s View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1496d749fa2fea75870d23a116918ccdcec43bca -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1496d749fa2fea75870d23a116918ccdcec43bca You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 12:19:05 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Wed, 08 Feb 2023 07:19:05 -0500 Subject: [Git][ghc/ghc][wip/js-generated-refs] 6 commits: Don't allow . in overloaded labels Message-ID: <63e39339ca705_730ce44cba7c134784@gitlab.mail> Josh Meredith pushed to branch wip/js-generated-refs at Glasgow Haskell Compiler / GHC Commits: b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - f83dbf41 by Josh Meredith at 2023-02-08T12:18:20+00:00 JS generated refs: update testsuite conditions - - - - - 15 changed files: - compiler/GHC/Core/TyCon.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/StgToJS/Printer.hs - docs/users_guide/9.6.1-notes.rst - libraries/base/GHC/Int.hs - libraries/base/GHC/Word.hs - testsuite/driver/runtests.py - testsuite/driver/testlib.py - testsuite/tests/driver/T1959/test.T - testsuite/tests/ffi/should_run/all.T - testsuite/tests/overloadedrecflds/should_run/T11671_run.hs - testsuite/tests/printer/Test22771.hs - testsuite/tests/rts/all.T - testsuite/tests/safeHaskell/check/pkg01/all.T - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -194,7 +194,7 @@ Note [Type synonym families] * Type synonym families, also known as "type functions", map directly onto the type functions in FC: - type family F a :: * + type family F a :: Type type instance F Int = Bool ..etc... @@ -210,11 +210,11 @@ Note [Type synonym families] type instance F (F Int) = ... -- BAD! * Translation of type family decl: - type family F a :: * + type family F a :: Type translates to a FamilyTyCon 'F', whose FamTyConFlav is OpenSynFamilyTyCon - type family G a :: * where + type family G a :: Type where G Int = Bool G Bool = Char G a = () @@ -229,7 +229,7 @@ Note [Data type families] See also Note [Wrappers for data instance tycons] in GHC.Types.Id.Make * Data type families are declared thus - data family T a :: * + data family T a :: Type data instance T Int = T1 | T2 Bool Here T is the "family TyCon". @@ -321,7 +321,7 @@ See also Note [Wrappers for data instance tycons] in GHC.Types.Id.Make should not think of a data family T as a *type function* at all, not even an injective one! We can't allow even injective type functions on the LHS of a type function: - type family injective G a :: * + type family injective G a :: Type type instance F (G Int) = Bool is no good, even if G is injective, because consider type instance G Int = Bool @@ -572,21 +572,21 @@ Since they are user-callable we must get their type-argument visibility information right; and that info is in the TyConBinders. Here is an example: - data App a b = MkApp (a b) -- App :: forall {k}. (k->*) -> k -> * + data App a b = MkApp (a b) -- App :: forall {k}. (k->Type) -> k -> Type The TyCon has - tyConTyBinders = [ Named (Bndr (k :: *) Inferred), Anon (k->*), Anon k ] + tyConTyBinders = [ Named (Bndr (k :: Type) Inferred), Anon (k->Type), Anon k ] The TyConBinders for App line up with App's kind, given above. But the DataCon MkApp has the type - MkApp :: forall {k} (a:k->*) (b:k). a b -> App k a b + MkApp :: forall {k} (a:k->Type) (b:k). a b -> App k a b That is, its ForAllTyBinders should be - dataConUnivTyVarBinders = [ Bndr (k:*) Inferred - , Bndr (a:k->*) Specified + dataConUnivTyVarBinders = [ Bndr (k:Type) Inferred + , Bndr (a:k->Type) Specified , Bndr (b:k) Specified ] So tyConTyVarBinders converts TyCon's TyConBinders into TyVarBinders: @@ -620,8 +620,8 @@ They fit together like so: type App a (b :: k) = a b - tyConBinders = [ Bndr (k::*) (NamedTCB Inferred) - , Bndr (a:k->*) AnonTCB + tyConBinders = [ Bndr (k::Type) (NamedTCB Inferred) + , Bndr (a:k->Type) AnonTCB , Bndr (b:k) AnonTCB ] Note that there are three binders here, including the @@ -636,13 +636,13 @@ They fit together like so: that TyVar may scope over some other part of the TyCon's definition. Eg type T a = a -> a we have - tyConBinders = [ Bndr (a:*) AnonTCB ] + tyConBinders = [ Bndr (a:Type) AnonTCB ] synTcRhs = a -> a So the 'a' scopes over the synTcRhs * From the tyConBinders and tyConResKind we can get the tyConKind E.g for our App example: - App :: forall k. (k->*) -> k -> * + App :: forall k. (k->Type) -> k -> Type We get a 'forall' in the kind for each NamedTCB, and an arrow for each AnonTCB @@ -725,15 +725,15 @@ instance Binary TyConBndrVis where -- things such as: -- -- 1) Data declarations: @data Foo = ...@ creates the @Foo@ type constructor of --- kind @*@ +-- kind @Type@ -- -- 2) Type synonyms: @type Foo = ...@ creates the @Foo@ type constructor -- -- 3) Newtypes: @newtype Foo a = MkFoo ...@ creates the @Foo@ type constructor --- of kind @* -> *@ +-- of kind @Type -> Type@ -- -- 4) Class declarations: @class Foo where@ creates the @Foo@ type constructor --- of kind @*@ +-- of kind @Constraint@ -- -- This data type also encodes a number of primitive, built in type constructors -- such as those for function and tuple types. @@ -1252,16 +1252,16 @@ data FamTyConFlav -- -- These are introduced by either a top level declaration: -- - -- > data family T a :: * + -- > data family T a :: Type -- -- Or an associated data type declaration, within a class declaration: -- -- > class C a b where - -- > data T b :: * + -- > data T b :: Type DataFamilyTyCon TyConRepName - -- | An open type synonym family e.g. @type family F x y :: * -> *@ + -- | An open type synonym family e.g. @type family F x y :: Type -> Type@ | OpenSynFamilyTyCon -- | A closed type synonym family e.g. ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -163,7 +163,6 @@ $small = [$ascsmall $unismall \_] $uniidchar = \x07 -- Trick Alex into handling Unicode. See Note [Unicode in Alex]. $idchar = [$small $large $digit $uniidchar \'] -$labelchar = [$small $large $digit $uniidchar \' \.] $unigraphic = \x06 -- Trick Alex into handling Unicode. See Note [Unicode in Alex]. $graphic = [$small $large $symbol $digit $idchar $special $unigraphic \"\'] @@ -455,7 +454,7 @@ $unigraphic / { isSmartQuote } { smart_quote_error } } <0> { - "#" $labelchar+ / { ifExtension OverloadedLabelsBit } { skip_one_varid_src ITlabelvarid } + "#" $idchar+ / { ifExtension OverloadedLabelsBit } { skip_one_varid_src ITlabelvarid } "#" \" / { ifExtension OverloadedLabelsBit } { lex_quoted_label } } ===================================== compiler/GHC/StgToJS/Printer.hs ===================================== @@ -108,19 +108,17 @@ ghcjsRenderJsV r (JHash m) where quoteIfRequired :: FastString -> Doc quoteIfRequired x - | isUnquotedKey x' = text x' - | otherwise = PP.squotes (text x') - where x' = unpackFS x - - isUnquotedKey :: String -> Bool - isUnquotedKey x | null x = False - | all isDigit x = True - | otherwise = validFirstIdent (head x) - && all validOtherIdent (tail x) + | isUnquotedKey x = ftext x + | otherwise = PP.squotes (ftext x) + isUnquotedKey :: FastString -> Bool + isUnquotedKey fs = case unpackFS fs of + [] -> False + s@(c:cs) -> all isDigit s || (validFirstIdent c && all validOtherIdent cs) validFirstIdent c = c == '_' || c == '$' || isAlpha c validOtherIdent c = isAlpha c || isDigit c + ghcjsRenderJsV r v = renderJsV defaultRenderJs r v prettyBlock :: RenderJs -> [JStat] -> Doc ===================================== docs/users_guide/9.6.1-notes.rst ===================================== @@ -84,7 +84,7 @@ Language This extends the variety syntax for constructing labels under :extension:`OverloadedLabels`. Examples of newly allowed syntax: - Leading capital letters: `#Foo` equivalant to `getLabel @"Foo"` - - Numeric characters: `#3.14` equivalent to `getLabel @"3.14"` + - Numeric characters: `#1728` equivalent to `getLabel @"1728"` - Arbitrary strings: `#"Hello, World!"` equivalent to `getLabel @"Hello, World!"` Compiler ===================================== libraries/base/GHC/Int.hs ===================================== @@ -69,8 +69,8 @@ instance Eq Int8 where (/=) = neInt8 eqInt8, neInt8 :: Int8 -> Int8 -> Bool -eqInt8 (I8# x) (I8# y) = isTrue# (x `eqInt8#` y) -neInt8 (I8# x) (I8# y) = isTrue# (x `neInt8#` y) +eqInt8 (I8# x) (I8# y) = isTrue# ((int8ToInt# x) ==# (int8ToInt# y)) +neInt8 (I8# x) (I8# y) = isTrue# ((int8ToInt# x) /=# (int8ToInt# y)) {-# INLINE [1] eqInt8 #-} {-# INLINE [1] neInt8 #-} @@ -280,8 +280,8 @@ instance Eq Int16 where (/=) = neInt16 eqInt16, neInt16 :: Int16 -> Int16 -> Bool -eqInt16 (I16# x) (I16# y) = isTrue# (x `eqInt16#` y) -neInt16 (I16# x) (I16# y) = isTrue# (x `neInt16#` y) +eqInt16 (I16# x) (I16# y) = isTrue# ((int16ToInt# x) ==# (int16ToInt# y)) +neInt16 (I16# x) (I16# y) = isTrue# ((int16ToInt# x) /=# (int16ToInt# y)) {-# INLINE [1] eqInt16 #-} {-# INLINE [1] neInt16 #-} @@ -488,8 +488,8 @@ instance Eq Int32 where (/=) = neInt32 eqInt32, neInt32 :: Int32 -> Int32 -> Bool -eqInt32 (I32# x) (I32# y) = isTrue# (x `eqInt32#` y) -neInt32 (I32# x) (I32# y) = isTrue# (x `neInt32#` y) +eqInt32 (I32# x) (I32# y) = isTrue# ((int32ToInt# x) ==# (int32ToInt# y)) +neInt32 (I32# x) (I32# y) = isTrue# ((int32ToInt# x) /=# (int32ToInt# y)) {-# INLINE [1] eqInt32 #-} {-# INLINE [1] neInt32 #-} ===================================== libraries/base/GHC/Word.hs ===================================== @@ -78,8 +78,8 @@ instance Eq Word8 where (/=) = neWord8 eqWord8, neWord8 :: Word8 -> Word8 -> Bool -eqWord8 (W8# x) (W8# y) = isTrue# (x `eqWord8#` y) -neWord8 (W8# x) (W8# y) = isTrue# (x `neWord8#` y) +eqWord8 (W8# x) (W8# y) = isTrue# ((word8ToWord# x) `eqWord#` (word8ToWord# y)) +neWord8 (W8# x) (W8# y) = isTrue# ((word8ToWord# x) `neWord#` (word8ToWord# y)) {-# INLINE [1] eqWord8 #-} {-# INLINE [1] neWord8 #-} @@ -268,8 +268,8 @@ instance Eq Word16 where (/=) = neWord16 eqWord16, neWord16 :: Word16 -> Word16 -> Bool -eqWord16 (W16# x) (W16# y) = isTrue# (x `eqWord16#` y) -neWord16 (W16# x) (W16# y) = isTrue# (x `neWord16#` y) +eqWord16 (W16# x) (W16# y) = isTrue# ((word16ToWord# x) `eqWord#` (word16ToWord# y)) +neWord16 (W16# x) (W16# y) = isTrue# ((word16ToWord# x) `neWord#` (word16ToWord# y)) {-# INLINE [1] eqWord16 #-} {-# INLINE [1] neWord16 #-} @@ -500,8 +500,8 @@ instance Eq Word32 where (/=) = neWord32 eqWord32, neWord32 :: Word32 -> Word32 -> Bool -eqWord32 (W32# x) (W32# y) = isTrue# (x `eqWord32#` y) -neWord32 (W32# x) (W32# y) = isTrue# (x `neWord32#` y) +eqWord32 (W32# x) (W32# y) = isTrue# ((word32ToWord# x) `eqWord#` (word32ToWord# y)) +neWord32 (W32# x) (W32# y) = isTrue# ((word32ToWord# x) `neWord#` (word32ToWord# y)) {-# INLINE [1] eqWord32 #-} {-# INLINE [1] neWord32 #-} ===================================== testsuite/driver/runtests.py ===================================== @@ -601,6 +601,7 @@ else: if args.junit: junit(t).write(args.junit) + args.junit.close() if config.only_report_hadrian_deps: print("WARNING - skipping all tests and only reporting required hadrian dependencies:", config.hadrian_deps) ===================================== testsuite/driver/testlib.py ===================================== @@ -1347,7 +1347,7 @@ def do_test(name: TestName, # if found and instead have the testsuite decide on what to do # with the output. def override_options(pre_cmd): - if config.verbose >= 5 and bool(re.match('\$make', pre_cmd, re.I)): + if config.verbose >= 5 and bool(re.match(r'\$make', pre_cmd, re.I)): return pre_cmd.replace(' -s' , '') \ .replace('--silent', '') \ .replace('--quiet' , '') @@ -1989,7 +1989,7 @@ def split_file(in_fn: Path, delimiter: str, out1_fn: Path, out2_fn: Path): with out1_fn.open('w', encoding='utf8', newline='') as out1: with out2_fn.open('w', encoding='utf8', newline='') as out2: line = infile.readline() - while re.sub('^\s*','',line) != delimiter and line != '': + while re.sub(r'^\s*','',line) != delimiter and line != '': out1.write(line) line = infile.readline() @@ -2399,20 +2399,20 @@ def normalise_errmsg(s: str) -> str: # warning message to get clean output. if config.msys: s = re.sub('Failed to remove file (.*); error= (.*)$', '', s) - s = re.sub('DeleteFile "(.+)": permission denied \(Access is denied\.\)(.*)$', '', s) + s = re.sub(r'DeleteFile "(.+)": permission denied \(Access is denied\.\)(.*)$', '', s) # filter out unsupported GNU_PROPERTY_TYPE (5), which is emitted by LLVM10 # and not understood by older binutils (ar, ranlib, ...) - s = modify_lines(s, lambda l: re.sub('^(.+)warning: (.+): unsupported GNU_PROPERTY_TYPE \(5\) type: 0xc000000(.*)$', '', l)) + s = modify_lines(s, lambda l: re.sub(r'^(.+)warning: (.+): unsupported GNU_PROPERTY_TYPE \(5\) type: 0xc000000(.*)$', '', l)) - s = re.sub('ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) + s = re.sub(r'ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) s = re.sub('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version','',s) # ignore superfluous dylibs passed to the linker. s = re.sub('ld: warning: .*, ignoring unexpected dylib file\n','',s) # ignore LLVM Version mismatch garbage; this will just break tests. s = re.sub('You are using an unsupported version of LLVM!.*\n','',s) - s = re.sub('Currently only [\.0-9]+ is supported. System LLVM version: [\.0-9]+.*\n','',s) - s = re.sub('We will try though\.\.\..*\n','',s) + s = re.sub('Currently only [\\.0-9]+ is supported. System LLVM version: [\\.0-9]+.*\n','',s) + s = re.sub('We will try though\\.\\.\\..*\n','',s) # ignore warning about strip invalidating signatures s = re.sub('.*strip: changes being made to the file will invalidate the code signature in.*\n','',s) # clang may warn about unused argument when used as assembler @@ -2475,8 +2475,8 @@ def normalise_slashes_( s: str ) -> str: return s def normalise_exe_( s: str ) -> str: - s = re.sub('\.exe', '', s) - s = re.sub('\.jsexe', '', s) + s = re.sub(r'\.exe', '', s) + s = re.sub(r'\.jsexe', '', s) return s def normalise_output( s: str ) -> str: @@ -2494,14 +2494,14 @@ def normalise_output( s: str ) -> str: # ghci outputs are pretty unstable with -fexternal-dynamic-refs, which is # requires for -fPIC s = re.sub(' -fexternal-dynamic-refs\n','',s) - s = re.sub('ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) + s = re.sub(r'ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) s = re.sub('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version','',s) # ignore superfluous dylibs passed to the linker. s = re.sub('ld: warning: .*, ignoring unexpected dylib file\n','',s) # ignore LLVM Version mismatch garbage; this will just break tests. s = re.sub('You are using an unsupported version of LLVM!.*\n','',s) - s = re.sub('Currently only [\.0-9]+ is supported. System LLVM version: [\.0-9]+.*\n','',s) - s = re.sub('We will try though\.\.\..*\n','',s) + s = re.sub('Currently only [\\.0-9]+ is supported. System LLVM version: [\\.0-9]+.*\n','',s) + s = re.sub('We will try though\\.\\.\\..*\n','',s) # ignore warning about strip invalidating signatures s = re.sub('.*strip: changes being made to the file will invalidate the code signature in.*\n','',s) # clang may warn about unused argument when used as assembler ===================================== testsuite/tests/driver/T1959/test.T ===================================== @@ -1 +1 @@ -test('T1959', [extra_files(['B.hs', 'C.hs', 'D.hs', 'E1.hs', 'E2.hs']), js_broken(22261)], makefile_test, ['dotest']) +test('T1959', [extra_files(['B.hs', 'C.hs', 'D.hs', 'E1.hs', 'E2.hs']), js_broken(22374)], makefile_test, ['dotest']) ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -167,10 +167,10 @@ test('T5594', [ omit_ways(['ghci']), ], compile_and_run, ['T5594_c.c -no-hs-main']) -test('Capi_Ctype_001', [extra_files(['Capi_Ctype_A_001.hsc', 'capi_ctype_001.h', 'capi_ctype_001_c.c']), js_broken(22374)], +test('Capi_Ctype_001', [extra_files(['Capi_Ctype_A_001.hsc', 'capi_ctype_001.h', 'capi_ctype_001_c.c']), req_c], makefile_test, ['Capi_Ctype_001']) -test('Capi_Ctype_002', [extra_files(['Capi_Ctype_A_002.hsc', 'capi_ctype_002_A.h', 'capi_ctype_002_B.h']), js_broken(22374)], +test('Capi_Ctype_002', [extra_files(['Capi_Ctype_A_002.hsc', 'capi_ctype_002_A.h', 'capi_ctype_002_B.h']), req_c], makefile_test, ['Capi_Ctype_002']) test('ffi_parsing_001', [omit_ways(['ghci']), req_c], compile_and_run, ===================================== testsuite/tests/overloadedrecflds/should_run/T11671_run.hs ===================================== @@ -12,8 +12,9 @@ import GHC.Prim (Addr#) instance KnownSymbol symbol => IsLabel symbol String where fromLabel = symbolVal (Proxy :: Proxy symbol) -(#) :: String -> Int -> String +(#), (#.) :: String -> Int -> String (#) _ i = show i +_ #. i = show i f :: Addr# -> Int -> String f _ i = show i @@ -26,13 +27,13 @@ main = traverse_ putStrLn , #type , #Foo , #3 - , #199.4 + , #"199.4" , #17a23b , #f'a' , #'a' , #' , #''notTHSplice - , #... + , #"..." , #привет , #こんにちは , #"3" ===================================== testsuite/tests/printer/Test22771.hs ===================================== @@ -14,8 +14,9 @@ import GHC.Prim (Addr#) instance KnownSymbol symbol => IsLabel symbol String where fromLabel = symbolVal (Proxy :: Proxy symbol) -(#) :: String -> Int -> String +(#), (#.) :: String -> Int -> String (#) _ i = show i +_ #. i = show i f :: Addr# -> Int -> String f _ i = show i @@ -28,13 +29,13 @@ main = traverse_ putStrLn , #type , #Foo , #3 - , #199.4 + , #"199.4" , #17a23b , #f'a' , #'a' , #' , #''notTHSplice - , #... + , #"..." , #привет , #こんにちは , #"3" ===================================== testsuite/tests/rts/all.T ===================================== @@ -258,7 +258,7 @@ test('T6006', [ omit_ways(prof_ways + ['ghci']), # needs it. compile_and_run, ['T6006_c.c -no-hs-main']) -test('T7037', js_broken(22374), makefile_test, ['T7037']) +test('T7037', req_c, makefile_test, ['T7037']) test('T7087', exit_code(1), compile_and_run, ['']) test('T7160', [ omit_ways(['nonmoving_thr', 'nonmoving_thr_ghc']) ===================================== testsuite/tests/safeHaskell/check/pkg01/all.T ===================================== @@ -32,7 +32,7 @@ test('safePkg01', normalise_version("array", "ghc-bignum", "bytestring", "base", "deepseq", "ghc-prim"), normalise_fun(normalise_errmsg), - js_skip], + js_broken(22356)], run_command, ['$MAKE -s --no-print-directory safePkg01 ' + make_args]) # Fail since we enable package trust ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -152,7 +152,7 @@ test('T7702', # allocation done by the plugin... but a regression allocates > 90mb collect_compiler_stats('peak_megabytes_allocated',70), when(opsys('mingw32'), fragile_for(16799, ['normal'])), - js_skip + req_interp ], compile, ['-v0 -package-db T7702plugin/pkg.T7702/local.package.conf -fplugin T7702Plugin -package T7702plugin ' + config.plugin_way_flags]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d5fd93325f1bdcc69dfaed5677d1af323dd9b8a6...f83dbf41e6a13e495d16d6a2f2e0ebb2eaf84382 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d5fd93325f1bdcc69dfaed5677d1af323dd9b8a6...f83dbf41e6a13e495d16d6a2f2e0ebb2eaf84382 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 12:55:53 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Wed, 08 Feb 2023 07:55:53 -0500 Subject: [Git][ghc/ghc][wip/js-rts-fixmes] JS RTS: use jsClosureCount for closureConstructors and cache sizes Message-ID: <63e39bd958aae_730ce527241451fb@gitlab.mail> Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC Commits: 96430354 by Josh Meredith at 2023-02-08T12:55:39+00:00 JS RTS: use jsClosureCount for closureConstructors and cache sizes - - - - - 2 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -133,6 +133,7 @@ module GHC.JS.Make , clsName , dataFieldName, dataFieldNames , varName, varNames + , jsClosureCount ) where @@ -642,10 +643,13 @@ instance Fractional JExpr where -- | Cache "dXXX" field names dataFieldCache :: Array Int FastString -dataFieldCache = listArray (0,nFieldCache) (map (mkFastString . ('d':) . show) [(0::Int)..nFieldCache]) +dataFieldCache = listArray (0,jsClosureCount) (map (mkFastString . ('d':) . show) [(0::Int)..nFieldCache]) nFieldCache :: Int -nFieldCache = 16384 +nFieldCache = 128 + +jsClosureCount :: Int +jsClosureCount = 24 dataFieldName :: Int -> FastString dataFieldName i @@ -653,44 +657,44 @@ dataFieldName i | otherwise = dataFieldCache ! i dataFieldNames :: [FastString] -dataFieldNames = fmap dataFieldName [1..nFieldCache] +dataFieldNames = fmap dataFieldName [1..jsClosureCount] -- | Cache "h$dXXX" names dataCache :: Array Int FastString -dataCache = listArray (0,63) (map (mkFastString . ("h$d"++) . show) [(0::Int)..63]) +dataCache = listArray (0,nFieldCache) (map (mkFastString . ("h$d"++) . show) [(0::Int)..nFieldCache]) dataName :: Int -> FastString dataName i - | i < 0 || i > 63 = panic "dataCacheName" (ppr i) - | otherwise = dataCache ! i + | i < 0 || i > nFieldCache = panic "dataCacheName" (ppr i) + | otherwise = dataCache ! i allocData :: Int -> JExpr allocData i = toJExpr (TxtI (dataCache ! i)) -- | Cache "h$cXXX" names clsCache :: Array Int FastString -clsCache = listArray (0,63) (map (mkFastString . ("h$c"++) . show) [(0::Int)..63]) +clsCache = listArray (0,nFieldCache) (map (mkFastString . ("h$c"++) . show) [(0::Int)..nFieldCache]) clsName :: Int -> FastString clsName i - | i < 0 || i > 63 = panic "clsCacheName" (ppr i) - | otherwise = clsCache ! i + | i < 0 || i > jsClosureCount = panic "clsCacheName" (ppr i) + | otherwise = clsCache ! i allocClsA :: Int -> JExpr allocClsA i = toJExpr (TxtI (clsCache ! i)) -- | Cache "xXXX" names varCache :: Array Int FastString -varCache = listArray (0,63) (map (mkFastString . ('x':) . show) [(0::Int)..63]) +varCache = listArray (0,jsClosureCount) (map (mkFastString . ('x':) . show) [(0::Int)..jsClosureCount]) varName :: Int -> Ident varName i - | i < 0 || i > 63 = panic "varCacheName" (ppr i) - | otherwise = TxtI $ varCache ! i + | i < 0 || i > jsClosureCount = panic "varCacheName" (ppr i) + | otherwise = TxtI $ varCache ! i varNames :: [Ident] -varNames = fmap varName [1..63] +varNames = fmap varName [1..jsClosureCount] -------------------------------------------------------------------------------- ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -81,8 +81,8 @@ resetResultVar r = toJExpr r |= null_ -- JIT can optimize better. closureConstructors :: StgToJSConfig -> JStat closureConstructors s = BlockStat - [ mconcat (map mkClosureCon (Nothing : map Just [0..24])) - , mconcat (map mkDataFill [1..24]) + [ mconcat (map mkClosureCon (Nothing : map Just [0..jsClosureCount])) + , mconcat (map mkDataFill [1..jsClosureCount]) ] where prof = csProf s View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/964303546c0d7f9cec77ba9c8d83484233e2395a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/964303546c0d7f9cec77ba9c8d83484233e2395a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 13:16:24 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Wed, 08 Feb 2023 08:16:24 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/andreask/expose-overloaded-unfoldings Message-ID: <63e3a0a88a54_730ce52724151084@gitlab.mail> Andreas Klebinger pushed new branch wip/andreask/expose-overloaded-unfoldings at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/expose-overloaded-unfoldings You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 13:19:55 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Wed, 08 Feb 2023 08:19:55 -0500 Subject: [Git][ghc/ghc][wip/9.2.6-backports] testsuite: Mark T9405 as fixed on windows Message-ID: <63e3a17b3078f_730ce527241530f@gitlab.mail> Zubin pushed to branch wip/9.2.6-backports at Glasgow Haskell Compiler / GHC Commits: 87c547c7 by Zubin Duggal at 2023-02-08T18:45:44+05:30 testsuite: Mark T9405 as fixed on windows - - - - - 1 changed file: - testsuite/tests/rts/all.T Changes: ===================================== testsuite/tests/rts/all.T ===================================== @@ -339,7 +339,7 @@ test('T10904', [ omit_ways(['ghci']), extra_run_opts('20000') ], test('T10728', [extra_run_opts('+RTS -maxN3 -RTS'), only_ways(['threaded2'])], compile_and_run, ['']) -test('T9405', [when(msys(), expect_broken(12714))], makefile_test, ['T9405']) +test('T9405', [], makefile_test, ['T9405']) test('T11788', when(ghc_dynamic(), skip), makefile_test, ['T11788']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/87c547c7bec75094127d7b73e2fc45650ba98ae2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/87c547c7bec75094127d7b73e2fc45650ba98ae2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 13:29:15 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 08 Feb 2023 08:29:15 -0500 Subject: [Git][ghc/ghc][wip/T22264-9.2] 15 commits: nonmoving: Fix handling of weak pointers Message-ID: <63e3a3aba1a84_730ce526981609b4@gitlab.mail> Ben Gamari pushed to branch wip/T22264-9.2 at Glasgow Haskell Compiler / GHC Commits: a7a00bfe by Ben Gamari at 2023-02-08T08:28:53-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. (cherry picked from commit a999f7b5b4b7316c088d7233a452fb33dc17646f) - - - - - fdb67349 by Ben Gamari at 2023-02-08T08:28:53-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. (cherry picked from commit 48b89dba91640fa977d038ea5283019c73f1b18e) - - - - - 8605ed71 by Ben Gamari at 2023-02-08T08:28:53-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive (cherry picked from commit 36ca160d0f199a688cf5fbc91d4bb92d2d4ea14e) - - - - - e8393f9e by Ben Gamari at 2023-02-08T08:28:53-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. (cherry picked from commit 8b64aff0fa978c762dfae8df235dd2b2a340656a) - - - - - adc7d1ab by Ben Gamari at 2023-02-08T08:28:53-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. (cherry picked from commit dde67d6e32ecff0e400f98213d42ae790babac09) - - - - - 012197a1 by Ben Gamari at 2023-02-08T08:28:53-05:00 nonmoving: Don't push if nonmoving collector isn't enabled (cherry picked from commit 8adc1750c02e596b4014d2837b4eb3d76bd130f2) - - - - - b6793745 by Ben Gamari at 2023-02-08T08:28:53-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. (cherry picked from commit c620669651c52fd228af61040747dd7236c4ba2b) - - - - - 0030ccdd by Ben Gamari at 2023-02-08T08:28:53-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys (cherry picked from commit 3887132fcd20f0a1edfc9f7006bdbed2634e2a8d) - - - - - d3675eef by Ben Gamari at 2023-02-08T08:28:53-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. (cherry picked from commit cc75031b4d93d4565e0428cb5910d9b9a645485b) - - - - - 5f2cfb0f by Ben Gamari at 2023-02-08T08:28:53-05:00 nonmoving: Add missing no-op in busy-wait loop (cherry picked from commit 9f931a8801c84b8ae473f91349e144eebc73b415) - - - - - e653408c by Ben Gamari at 2023-02-08T08:28:53-05:00 nonmoving: Move current segment array into Capability (cherry picked from commit 9d245c1baec91ee79d715062b127e487456d9c9e) - - - - - 6deed56a by Ben Gamari at 2023-02-08T08:28:54-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. (cherry picked from commit 6bdce35cdd59112a8cb4a4a3b061e854ada3ff63) - - - - - b5bb4ebb by Ben Gamari at 2023-02-08T08:28:54-05:00 nonmoving: Fix unregisterised build (cherry picked from commit 6df2709e7215ea80d7267800e0318aee2a7c277f) - - - - - f082d6cc by Ben Gamari at 2023-02-08T08:28:54-05:00 nonmoving: Avoid n_caps race (cherry picked from commit c00d6de815d4e125c1c4d8ff06549042f502f759) - - - - - edaab724 by Ben Gamari at 2023-02-08T08:28:54-05:00 relnotes: Mention various non-moving GC fixes - - - - - 16 changed files: - docs/users_guide/9.2.6-notes.rst - rts/Capability.c - rts/Capability.h - rts/RtsStartup.c - rts/Schedule.c - rts/sm/Evac.c - rts/sm/GC.c - rts/sm/MarkWeak.c - rts/sm/NonMoving.c - rts/sm/NonMoving.h - rts/sm/NonMovingCensus.c - rts/sm/NonMovingCensus.h - rts/sm/NonMovingMark.c - rts/sm/NonMovingMark.h - rts/sm/Sanity.c - rts/sm/Storage.c Changes: ===================================== docs/users_guide/9.2.6-notes.rst ===================================== @@ -66,6 +66,23 @@ Runtime system - Truncate eventlog events with a large payload (:ghc-ticket:`20221`). +- A bug in the nonmoving garbage collector regarding the treatment of + zero-length ``SmallArray#``\ s has been fixed (:ghc-ticket:`22264`) + +- A number of bugs regarding the non-moving garbage collector's treatment of + ``Weak#`` pointers have been fixed (:ghc-ticket:`22327`) + +- A few race conditions between the non-moving collector and + ``setNumCapabilities`` which could result in undefined behavior have been + fixed (:ghc-ticket:`22926`, :ghc-ticket:`22927`) + +- The non-moving collector is now able to better schedule marking work during + the post-mark synchronization phase of collection, significantly reducing + pause times in some workloads (:ghc-ticket:`22929`). + +- Various bugs in the non-moving collector's implementation of the selector + optimisation have been fixed (:ghc-ticket:`22930`) + Build system and packaging -------------------------- ===================================== rts/Capability.c ===================================== @@ -294,6 +294,7 @@ initCapability (Capability *cap, uint32_t i) cap->saved_mut_lists = stgMallocBytes(sizeof(bdescr *) * RtsFlags.GcFlags.generations, "initCapability"); + cap->current_segments = NULL; // At this point storage manager is not initialized yet, so this will be @@ -1267,6 +1268,9 @@ freeCapability (Capability *cap) { stgFree(cap->mut_lists); stgFree(cap->saved_mut_lists); + if (cap->current_segments) { + stgFree(cap->current_segments); + } #if defined(THREADED_RTS) freeSparkPool(cap->sparks); #endif ===================================== rts/Capability.h ===================================== @@ -88,6 +88,9 @@ struct Capability_ { // The update remembered set for the non-moving collector UpdRemSet upd_rem_set; + // Array of current segments for the non-moving collector. + // Of length NONMOVING_ALLOCA_CNT. + struct NonmovingSegment **current_segments; // block for allocating pinned objects into bdescr *pinned_object_block; ===================================== rts/RtsStartup.c ===================================== @@ -472,6 +472,7 @@ hs_exit_(bool wait_foreign) for (g = 0; g < RtsFlags.GcFlags.generations; g++) { runAllCFinalizers(generations[g].weak_ptr_list); } + runAllCFinalizers(nonmoving_weak_ptr_list); #if defined(RTS_USER_SIGNALS) if (RtsFlags.MiscFlags.install_signal_handlers) { ===================================== rts/Schedule.c ===================================== @@ -1710,7 +1710,9 @@ scheduleDoGC (Capability **pcap, Task *task USED_IF_THREADS, stat_startGCSync(gc_threads[cap->no]); +#if defined(DEBUG) unsigned int old_n_capabilities = getNumCapabilities(); +#endif interruptAllCapabilities(); @@ -2306,7 +2308,9 @@ setNumCapabilities (uint32_t new_n_capabilities USED_IF_THREADS) moreCapabilities(n_capabilities, new_n_capabilities); // Resize and update storage manager data structures + ACQUIRE_SM_LOCK; storageAddCapabilities(n_capabilities, new_n_capabilities); + RELEASE_SM_LOCK; } } ===================================== rts/sm/Evac.c ===================================== @@ -1254,6 +1254,10 @@ selector_chain: uint16_t flags = RELAXED_LOAD(&bd->flags); if (flags & (BF_EVACUATED | BF_NONMOVING)) { unchain_thunk_selectors(prev_thunk_selector, (StgClosure *)p); + if (flags & BF_NONMOVING) { + // See Note [Non-moving GC: Marking evacuated objects]. + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure*) p); + } *q = (StgClosure *)p; // shortcut, behave as for: if (evac) evacuate(q); if (evac && bd->gen_no < gct->evac_gen_no) { @@ -1308,6 +1312,12 @@ selector_chain: // - undo the chain we've built to point to p. SET_INFO((StgClosure *)p, (const StgInfoTable *)info_ptr); RELEASE_STORE(q, (StgClosure *) p); + if (Bdescr((StgPtr)p)->flags & BF_NONMOVING) { + // See Note [Non-moving GC: Marking evacuated objects]. + // TODO: This really shouldn't be necessary since whoever won + // the race should have pushed + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure*) p); + } if (evac) evacuate(q); unchain_thunk_selectors(prev_thunk_selector, (StgClosure *)p); return; @@ -1398,6 +1408,11 @@ selector_loop: case THUNK_SELECTOR: // Use payload to make a list of thunk selectors, to be // used in unchain_thunk_selectors + // + // FIXME: This seems racy; should we lock this selector to + // ensure that another thread doesn't clobber this node + // of the chain. This would result in some previous + // selectors not being updated when we unchain. RELAXED_STORE(&((StgClosure*)p)->payload[0], (StgClosure *)prev_thunk_selector); prev_thunk_selector = p; p = (StgSelector*)val; @@ -1422,6 +1437,12 @@ selector_loop: // eval_thunk_selector(), because we know val is not // a THUNK_SELECTOR. if (evac) evacuate(q); + + if (isNonmovingClosure(*q)) { + // See Note [Non-moving GC: Marking evacuated objects]. + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure*) *q); + } + return; } @@ -1466,6 +1487,10 @@ selector_loop: // recurse indefinitely, so we impose a depth bound. // See Note [Selector optimisation depth limit]. if (gct->thunk_selector_depth >= MAX_THUNK_SELECTOR_DEPTH) { + if (isNonmovingClosure((StgClosure *) p)) { + // See Note [Non-moving GC: Marking evacuated objects]. + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure*) p); + } goto bale_out; } @@ -1512,5 +1537,9 @@ bale_out: if (evac) { copy(q,(const StgInfoTable *)info_ptr,(StgClosure *)p,THUNK_SELECTOR_sizeW(),bd->dest_no); } + if (isNonmovingClosure(*q)) { + // See Note [Non-moving GC: Marking evacuated objects]. + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, *q); + } unchain_thunk_selectors(prev_thunk_selector, *q); } ===================================== rts/sm/GC.c ===================================== @@ -375,7 +375,8 @@ GarbageCollect (uint32_t collect_gen, static_flag == STATIC_FLAG_A ? STATIC_FLAG_B : STATIC_FLAG_A; } - if (major_gc) { + /* N.B. We currently don't unload code with the non-moving collector. */ + if (major_gc && !RtsFlags.GcFlags.useNonmoving) { unload_mark_needed = prepareUnloadCheck(); } else { unload_mark_needed = false; ===================================== rts/sm/MarkWeak.c ===================================== @@ -50,7 +50,7 @@ - weak_stage == WeakPtrs - We process all the weak pointers whos keys are alive (evacuate + We process all the weak pointers whose keys are alive (evacuate their values and finalizers), and repeat until we can find no new live keys. If no live keys are found in this pass, then we evacuate the finalizers of all the dead weak pointers in order to @@ -82,12 +82,46 @@ static bool tidyWeakList (generation *gen); static bool resurrectUnreachableThreads (generation *gen, StgTSO **resurrected_threads); static void tidyThreadList (generation *gen); +/* + * Note [Weak pointer processing and the non-moving GC] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * When using the non-moving GC we defer weak pointer processing + * until the concurrent marking phase as weaks in the non-moving heap may be + * keyed on objects living in the non-moving generation. To accomplish this + * initWeakForGC keeps all weak pointers on oldest_gen->weak_ptr_list, where + * nonmovingCollect will find them. From there they will be moved to + * nonmoving_old_weak_ptr_list. During the mark loop we will move weaks with + * reachable keys to nonmoving_weak_ptr_list. At the end of concurrent marking + * we tidy the weak list (in nonmovingTidyWeakList) and perform another set of + * marking as necessary, just as is done in tidyWeakList. + * + * Note that this treatment takes advantage of the fact that we usually need + * not worry about Weak#s living in the non-moving heap but being keyed on an + * object in the moving heap since the Weak# must be strictly older than the + * key. Such objects would otherwise pose a problem since the non-moving + * collector would be unable to safely determine the liveness of the key. + * In the rare case that we *do* see such a key (e.g. in the case of a + * pinned ByteArray# living in a partially-filled accumulator block) + * the nonmoving collector assumes that it is live. + * + */ + +/* + * Prepare the weak object lists for GC. Specifically, reset weak_stage + * and move all generations' `weak_ptr_list`s to `old_weak_ptr_list`. + * Weaks with live keys will later be moved back to `weak_ptr_list` by + * `tidyWeakList`. + */ void initWeakForGC(void) { - uint32_t g; + uint32_t oldest = N; + if (RtsFlags.GcFlags.useNonmoving && N == oldest_gen->no) { + // See Note [Weak pointer processing and the non-moving GC]. + oldest = oldest_gen->no - 1; + } - for (g = 0; g <= N; g++) { + for (uint32_t g = 0; g <= oldest; g++) { generation *gen = &generations[g]; gen->old_weak_ptr_list = gen->weak_ptr_list; gen->weak_ptr_list = NULL; @@ -96,6 +130,14 @@ initWeakForGC(void) weak_stage = WeakThreads; } +/* + * Walk the weak pointer lists after having finished a round of scavenging, + * tidying the weak (and possibly thread) lists (depending upon the current + * weak_stage). + * + * Returns true if new live weak pointers were found, implying that another + * round of scavenging is necessary. + */ bool traverseWeakPtrList(StgWeak **dead_weak_ptr_list, StgTSO **resurrected_threads) { @@ -182,6 +224,11 @@ traverseWeakPtrList(StgWeak **dead_weak_ptr_list, StgTSO **resurrected_threads) } } +/* + * Deal with weak pointers with unreachable keys after GC has concluded. + * This means marking the finalizer (and possibly value) in preparation for + * later finalization. + */ static void collectDeadWeakPtrs (generation *gen, StgWeak **dead_weak_ptr_list) { StgWeak *w, *next_w; @@ -198,6 +245,10 @@ static void collectDeadWeakPtrs (generation *gen, StgWeak **dead_weak_ptr_list) } } +/* + * Deal with threads left on the old_threads list after GC has concluded, + * moving them onto the resurrected_threads list where appropriate. + */ static bool resurrectUnreachableThreads (generation *gen, StgTSO **resurrected_threads) { StgTSO *t, *tmp, *next; @@ -233,8 +284,21 @@ static bool resurrectUnreachableThreads (generation *gen, StgTSO **resurrected_t return flag; } +/* + * Walk over the `old_weak_ptr_list` of the given generation and: + * + * - remove any DEAD_WEAKs + * - move any weaks with reachable keys to the `weak_ptr_list` of the + * appropriate to-space and mark the weak's value and finalizer. + */ static bool tidyWeakList(generation *gen) { + if (RtsFlags.GcFlags.useNonmoving && gen == oldest_gen) { + // See Note [Weak pointer processing and the non-moving GC]. + ASSERT(gen->old_weak_ptr_list == NULL); + return false; + } + StgWeak *w, **last_w, *next_w; const StgInfoTable *info; StgClosure *new; @@ -322,6 +386,10 @@ static bool tidyWeakList(generation *gen) return flag; } +/* + * Walk over the `old_threads` list of the given generation and move any + * reachable threads onto the `threads` list. + */ static void tidyThreadList (generation *gen) { StgTSO *t, *tmp, *next, **prev; @@ -381,6 +449,10 @@ static void checkWeakPtrSanity(StgWeak *hd, StgWeak *tl) } #endif +/* + * Traverse the capabilities' local new-weak-pointer lists at the beginning of + * GC and move them to the nursery's weak_ptr_list. + */ void collectFreshWeakPtrs() { uint32_t i; ===================================== rts/sm/NonMoving.c ===================================== @@ -244,6 +244,12 @@ Mutex concurrent_coll_finished_lock; * how we use the DIRTY flags associated with MUT_VARs and TVARs to improve * barrier efficiency. * + * - Note [Weak pointer processing and the non-moving GC] (MarkWeak.c) describes + * how weak pointers are handled when the non-moving GC is in use. + * + * - Note [Sync phase marking budget] describes how we avoid long mutator + * pauses during the sync phase + * * [ueno 2016]: * Katsuhiro Ueno and Atsushi Ohori. 2016. A fully concurrent garbage * collector for functional programs on multicore processors. SIGPLAN Not. 51, @@ -292,6 +298,7 @@ Mutex concurrent_coll_finished_lock; * ┆ * B ←────────────── A ←─────────────── root * │ ┆ ↖─────────────── gen1 mut_list + * │ ┆ * ╰───────────────→ C * ┆ * @@ -332,6 +339,7 @@ Mutex concurrent_coll_finished_lock; * The implementation details of this are described in Note [Non-moving GC: * Marking evacuated objects] in Evac.c. * + * * Note [Deadlock detection under the non-moving collector] * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ * In GHC the garbage collector is responsible for identifying deadlocked @@ -493,10 +501,44 @@ Mutex concurrent_coll_finished_lock; * remembered set during the preparatory GC. This allows us to safely skip the * non-moving write barrier without jeopardizing the snapshot invariant. * + * + * Note [Sync phase marking budget] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * The non-moving collector is intended to provide reliably low collection + * latencies. These latencies are primarily due to two sources: + * + * a. the preparatory moving collection at the beginning of the major GC cycle + * b. the post-mark synchronization pause at the end + * + * While the cost of (a) is inherently bounded by the young generation size, + * (b) can in principle be unbounded since the mutator may hide large swathes + * of heap from the collector's concurrent mark phase via mutation. These will + * only become visible to the collector during the post-mark synchronization + * phase. + * + * Since we don't want to do unbounded marking work in the pause, we impose a + * limit (specifically, sync_phase_marking_budget) on the amount of work + * (namely, the number of marked closures) that we can do during the pause. If + * we deplete our marking budget during the pause then we allow the mutators to + * resume and return to concurrent marking (keeping the update remembered set + * write barrier enabled). After we have finished marking we will again + * attempt the post-mark synchronization. + * + * The choice of sync_phase_marking_budget was made empirically. On 2022 + * hardware and a "typical" test program we tend to mark ~10^7 closures per + * second. Consequently, a sync_phase_marking_budget of 10^5 should produce + * ~10 ms pauses, which seems like a reasonable tradeoff. + * + * TODO: Perhaps sync_phase_marking_budget should be controllable via a + * command-line argument? + * */ memcount nonmoving_live_words = 0; +// See Note [Sync phase marking budget]. +MarkBudget sync_phase_marking_budget = 200000; + #if defined(THREADED_RTS) static void* nonmovingConcurrentMark(void *mark_queue); #endif @@ -665,10 +707,11 @@ void *nonmovingAllocate(Capability *cap, StgWord sz) // object and not moved) which is covered by allocator 9. ASSERT(log_block_size < NONMOVING_ALLOCA0 + NONMOVING_ALLOCA_CNT); - struct NonmovingAllocator *alloca = nonmovingHeap.allocators[log_block_size - NONMOVING_ALLOCA0]; + unsigned int alloca_idx = log_block_size - NONMOVING_ALLOCA0; + struct NonmovingAllocator *alloca = &nonmovingHeap.allocators[alloca_idx]; // Allocate into current segment - struct NonmovingSegment *current = alloca->current[cap->no]; + struct NonmovingSegment *current = cap->current_segments[alloca_idx]; ASSERT(current); // current is never NULL void *ret = nonmovingSegmentGetBlock_(current, log_block_size, current->next_free); ASSERT(GET_CLOSURE_TAG(ret) == 0); // check alignment @@ -701,29 +744,12 @@ void *nonmovingAllocate(Capability *cap, StgWord sz) // make it current new_current->link = NULL; SET_SEGMENT_STATE(new_current, CURRENT); - alloca->current[cap->no] = new_current; + cap->current_segments[alloca_idx] = new_current; } return ret; } -/* Allocate a nonmovingAllocator */ -static struct NonmovingAllocator *alloc_nonmoving_allocator(uint32_t n_caps) -{ - size_t allocator_sz = - sizeof(struct NonmovingAllocator) + - sizeof(void*) * n_caps; // current segment pointer for each capability - struct NonmovingAllocator *alloc = - stgMallocBytes(allocator_sz, "nonmovingInit"); - memset(alloc, 0, allocator_sz); - return alloc; -} - -static void free_nonmoving_allocator(struct NonmovingAllocator *alloc) -{ - stgFree(alloc); -} - void nonmovingInit(void) { if (! RtsFlags.GcFlags.useNonmoving) return; @@ -732,10 +758,7 @@ void nonmovingInit(void) initCondition(&concurrent_coll_finished); initMutex(&concurrent_coll_finished_lock); #endif - for (unsigned int i = 0; i < NONMOVING_ALLOCA_CNT; i++) { - nonmovingHeap.allocators[i] = alloc_nonmoving_allocator(getNumCapabilities()); - } - nonmovingMarkInitUpdRemSet(); + nonmovingMarkInit(); } // Stop any nonmoving collection in preparation for RTS shutdown. @@ -764,44 +787,24 @@ void nonmovingExit(void) closeCondition(&concurrent_coll_finished); closeMutex(&nonmoving_collection_mutex); #endif - - for (unsigned int i = 0; i < NONMOVING_ALLOCA_CNT; i++) { - free_nonmoving_allocator(nonmovingHeap.allocators[i]); - } } -/* - * Assumes that no garbage collector or mutator threads are running to safely - * resize the nonmoving_allocators. - * - * Must hold sm_mutex. - */ -void nonmovingAddCapabilities(uint32_t new_n_caps) +/* Initialize a new capability. Caller must hold SM_LOCK */ +void nonmovingInitCapability(Capability *cap) { - unsigned int old_n_caps = nonmovingHeap.n_caps; - struct NonmovingAllocator **allocs = nonmovingHeap.allocators; - + // Initialize current segment array + struct NonmovingSegment **segs = + stgMallocBytes(sizeof(struct NonmovingSegment*) * NONMOVING_ALLOCA_CNT, "current segment array"); for (unsigned int i = 0; i < NONMOVING_ALLOCA_CNT; i++) { - struct NonmovingAllocator *old = allocs[i]; - allocs[i] = alloc_nonmoving_allocator(new_n_caps); - - // Copy the old state - allocs[i]->filled = old->filled; - allocs[i]->active = old->active; - for (unsigned int j = 0; j < old_n_caps; j++) { - allocs[i]->current[j] = old->current[j]; - } - stgFree(old); - - // Initialize current segments for the new capabilities - for (unsigned int j = old_n_caps; j < new_n_caps; j++) { - allocs[i]->current[j] = nonmovingAllocSegment(capabilities[j]->node); - nonmovingInitSegment(allocs[i]->current[j], NONMOVING_ALLOCA0 + i); - SET_SEGMENT_STATE(allocs[i]->current[j], CURRENT); - allocs[i]->current[j]->link = NULL; - } + segs[i] = nonmovingAllocSegment(cap->node); + nonmovingInitSegment(segs[i], NONMOVING_ALLOCA0 + i); + SET_SEGMENT_STATE(segs[i], CURRENT); } - nonmovingHeap.n_caps = new_n_caps; + cap->current_segments = segs; + + // Initialize update remembered set + cap->upd_rem_set.queue.blocks = NULL; + nonmovingInitUpdRemSet(&cap->upd_rem_set); } void nonmovingClearBitmap(struct NonmovingSegment *seg) @@ -821,18 +824,21 @@ static void nonmovingPrepareMark(void) // Should have been cleared by the last sweep ASSERT(nonmovingHeap.sweep_list == NULL); + nonmovingHeap.n_caps = n_capabilities; nonmovingBumpEpoch(); for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { - struct NonmovingAllocator *alloca = nonmovingHeap.allocators[alloca_idx]; + struct NonmovingAllocator *alloca = &nonmovingHeap.allocators[alloca_idx]; // Update current segments' snapshot pointers - for (uint32_t cap_n = 0; cap_n < getNumCapabilities(); ++cap_n) { - struct NonmovingSegment *seg = alloca->current[cap_n]; + for (uint32_t cap_n = 0; cap_n < nonmovingHeap.n_caps; ++cap_n) { + Capability *cap = capabilities[cap_n]; + struct NonmovingSegment *seg = cap->current_segments[alloca_idx]; nonmovingSegmentInfo(seg)->next_free_snap = seg->next_free; } // Save the filled segments for later processing during the concurrent // mark phase. + ASSERT(alloca->saved_filled == NULL); alloca->saved_filled = alloca->filled; alloca->filled = NULL; @@ -886,44 +892,7 @@ static void nonmovingPrepareMark(void) #endif } -// Mark weak pointers in the non-moving heap. They'll either end up in -// dead_weak_ptr_list or stay in weak_ptr_list. Either way they need to be kept -// during sweep. See `MarkWeak.c:markWeakPtrList` for the moving heap variant -// of this. -static void nonmovingMarkWeakPtrList(MarkQueue *mark_queue, StgWeak *dead_weak_ptr_list) -{ - for (StgWeak *w = oldest_gen->weak_ptr_list; w; w = w->link) { - markQueuePushClosureGC(mark_queue, (StgClosure*)w); - // Do not mark finalizers and values here, those fields will be marked - // in `nonmovingMarkDeadWeaks` (for dead weaks) or - // `nonmovingTidyWeaks` (for live weaks) - } - - // We need to mark dead_weak_ptr_list too. This is subtle: - // - // - By the beginning of this GC we evacuated all weaks to the non-moving - // heap (in `markWeakPtrList`) - // - // - During the scavenging of the moving heap we discovered that some of - // those weaks are dead and moved them to `dead_weak_ptr_list`. Note that - // because of the fact above _all weaks_ are in the non-moving heap at - // this point. - // - // - So, to be able to traverse `dead_weak_ptr_list` and run finalizers we - // need to mark it. - for (StgWeak *w = dead_weak_ptr_list; w; w = w->link) { - markQueuePushClosureGC(mark_queue, (StgClosure*)w); - - // Mark the value and finalizer since they will be needed regardless of - // whether we find the weak is live. - if (w->cfinalizers != &stg_NO_FINALIZER_closure) { - markQueuePushClosureGC(mark_queue, w->value); - } - markQueuePushClosureGC(mark_queue, w->finalizer); - } -} - -void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) +void nonmovingCollect(StgWeak **dead_weaks STG_UNUSED, StgTSO **resurrected_threads) { #if defined(THREADED_RTS) // We can't start a new collection until the old one has finished @@ -945,6 +914,7 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) ASSERT(n_nonmoving_marked_compact_blocks == 0); MarkQueue *mark_queue = stgMallocBytes(sizeof(MarkQueue), "mark queue"); + mark_queue->blocks = NULL; initMarkQueue(mark_queue); current_mark_queue = mark_queue; @@ -956,9 +926,16 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) capabilities[n], true/*don't mark sparks*/); } markScheduler((evac_fn)markQueueAddRoot, mark_queue); - nonmovingMarkWeakPtrList(mark_queue, *dead_weaks); markStablePtrTable((evac_fn)markQueueAddRoot, mark_queue); + // The dead weak pointer list shouldn't contain any weaks in the + // nonmoving heap +#if defined(DEBUG) + for (StgWeak *w = *dead_weaks; w; w = w->link) { + ASSERT(Bdescr((StgPtr) w)->gen != oldest_gen); + } +#endif + // Mark threads resurrected during moving heap scavenging for (StgTSO *tso = *resurrected_threads; tso != END_TSO_QUEUE; tso = tso->global_link) { markQueuePushClosureGC(mark_queue, (StgClosure*)tso); @@ -984,8 +961,23 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) // alive). ASSERT(oldest_gen->old_weak_ptr_list == NULL); ASSERT(nonmoving_old_weak_ptr_list == NULL); - nonmoving_old_weak_ptr_list = oldest_gen->weak_ptr_list; - oldest_gen->weak_ptr_list = NULL; + { + // Move both oldest_gen->weak_ptr_list and nonmoving_weak_ptr_list to + // nonmoving_old_weak_ptr_list + StgWeak **weaks = &oldest_gen->weak_ptr_list; + uint32_t n = 0; + while (*weaks) { + weaks = &(*weaks)->link; + n++; + } + debugTrace(DEBUG_nonmoving_gc, "%d new nonmoving weaks", n); + *weaks = nonmoving_weak_ptr_list; + nonmoving_old_weak_ptr_list = oldest_gen->weak_ptr_list; + nonmoving_weak_ptr_list = NULL; + oldest_gen->weak_ptr_list = NULL; + // At this point all weaks in the nonmoving generation are on + // nonmoving_old_weak_ptr_list + } trace(TRACE_nonmoving_gc, "Finished nonmoving GC preparation"); // We are now safe to start concurrent marking @@ -1021,19 +1013,25 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) } /* Mark queue, threads, and weak pointers until no more weaks have been - * resuscitated + * resuscitated. If *budget is non-zero then we will mark no more than + * Returns true if we there is no more marking work to be done, false if + * we exceeded our marking budget. */ -static void nonmovingMarkThreadsWeaks(MarkQueue *mark_queue) +static bool nonmovingMarkThreadsWeaks(MarkBudget *budget, MarkQueue *mark_queue) { while (true) { // Propagate marks - nonmovingMark(mark_queue); + nonmovingMark(budget, mark_queue); + if (*budget == 0) { + return false; + } // Tidy threads and weaks nonmovingTidyThreads(); - if (! nonmovingTidyWeaks(mark_queue)) - return; + if (! nonmovingTidyWeaks(mark_queue)) { + return true; + } } } @@ -1047,7 +1045,6 @@ static void* nonmovingConcurrentMark(void *data) return NULL; } -// TODO: Not sure where to put this function. // Append w2 to the end of w1. static void appendWeakList( StgWeak **w1, StgWeak *w2 ) { @@ -1067,13 +1064,14 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * // Walk the list of filled segments that we collected during preparation, // updated their snapshot pointers and move them to the sweep list. for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { - struct NonmovingSegment *filled = nonmovingHeap.allocators[alloca_idx]->saved_filled; + struct NonmovingSegment *filled = nonmovingHeap.allocators[alloca_idx].saved_filled; uint32_t n_filled = 0; if (filled) { struct NonmovingSegment *seg = filled; while (true) { // Set snapshot nonmovingSegmentInfo(seg)->next_free_snap = seg->next_free; + SET_SEGMENT_STATE(seg, FILLED_SWEEPING); n_filled++; if (seg->link) { seg = seg->link; @@ -1082,14 +1080,24 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * } } // add filled segments to sweep_list - SET_SEGMENT_STATE(seg, FILLED_SWEEPING); seg->link = nonmovingHeap.sweep_list; nonmovingHeap.sweep_list = filled; } + nonmovingHeap.allocators[alloca_idx].saved_filled = NULL; } + // Mark Weak#s + nonmovingMarkWeakPtrList(mark_queue); + // Do concurrent marking; most of the heap will get marked here. - nonmovingMarkThreadsWeaks(mark_queue); + +#if defined(THREADED_RTS) +concurrent_marking: +#endif + { + MarkBudget budget = UNLIMITED_MARK_BUDGET; + nonmovingMarkThreadsWeaks(&budget, mark_queue); + } #if defined(THREADED_RTS) Task *task = newBoundTask(); @@ -1098,21 +1106,13 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * if (sched_state > SCHED_RUNNING) { // Note that we break our invariants here and leave segments in // nonmovingHeap.sweep_list, don't free nonmoving_large_objects etc. - // However because we won't be running mark-sweep in the final GC this + // However because we won't be running sweep in the final GC this // is OK. - - // This is a RTS shutdown so we need to move our copy (snapshot) of - // weaks (nonmoving_old_weak_ptr_list and nonmoving_weak_ptr_list) to - // oldest_gen->threads to be able to run C finalizers in hs_exit_. Note - // that there may be more weaks added to oldest_gen->threads since we - // started mark, so we need to append our list to the tail of - // oldest_gen->threads. - appendWeakList(&nonmoving_old_weak_ptr_list, nonmoving_weak_ptr_list); - appendWeakList(&oldest_gen->weak_ptr_list, nonmoving_old_weak_ptr_list); - // These lists won't be used again so this is not necessary, but still - nonmoving_old_weak_ptr_list = NULL; - nonmoving_weak_ptr_list = NULL; - + // + // However, we must move any weak pointers remaining on + // nonmoving_old_weak_ptr_list back to nonmoving_weak_ptr_list + // such that their C finalizers can be run by hs_exit_. + appendWeakList(&nonmoving_weak_ptr_list, nonmoving_old_weak_ptr_list); goto finish; } @@ -1120,9 +1120,17 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * nonmovingBeginFlush(task); bool all_caps_syncd; + MarkBudget sync_marking_budget = sync_phase_marking_budget; do { all_caps_syncd = nonmovingWaitForFlush(); - nonmovingMarkThreadsWeaks(mark_queue); + if (nonmovingMarkThreadsWeaks(&sync_marking_budget, mark_queue) == false) { + // We ran out of budget for marking. Abort sync. + // See Note [Sync phase marking budget]. + traceConcSyncEnd(); + stat_endNonmovingGcSync(); + releaseAllCapabilities(n_capabilities, NULL, task); + goto concurrent_marking; + } } while (!all_caps_syncd); #endif @@ -1133,7 +1141,7 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * // Do last marking of weak pointers while (true) { // Propagate marks - nonmovingMark(mark_queue); + nonmovingMarkUnlimitedBudget(mark_queue); if (!nonmovingTidyWeaks(mark_queue)) break; @@ -1142,7 +1150,7 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * nonmovingMarkDeadWeaks(mark_queue, dead_weaks); // Propagate marks - nonmovingMark(mark_queue); + nonmovingMarkUnlimitedBudget(mark_queue); // Now remove all dead objects from the mut_list to ensure that a younger // generation collection doesn't attempt to look at them after we've swept. @@ -1184,15 +1192,9 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * nonmoving_old_threads = END_TSO_QUEUE; } - { - StgWeak **weaks = &oldest_gen->weak_ptr_list; - while (*weaks) { - weaks = &(*weaks)->link; - } - *weaks = nonmoving_weak_ptr_list; - nonmoving_weak_ptr_list = NULL; - nonmoving_old_weak_ptr_list = NULL; - } + // At this point point any weak that remains on nonmoving_old_weak_ptr_list + // has a dead key. + nonmoving_old_weak_ptr_list = NULL; // Prune spark lists // See Note [Spark management under the nonmoving collector]. @@ -1290,10 +1292,12 @@ void assert_in_nonmoving_heap(StgPtr p) } for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { - struct NonmovingAllocator *alloca = nonmovingHeap.allocators[alloca_idx]; + struct NonmovingAllocator *alloca = &nonmovingHeap.allocators[alloca_idx]; + // Search current segments - for (uint32_t cap_idx = 0; cap_idx < getNumCapabilities(); ++cap_idx) { - struct NonmovingSegment *seg = alloca->current[cap_idx]; + for (uint32_t cap_idx = 0; cap_idx < nonmovingHeap.n_caps; ++cap_idx) { + Capability *cap = capabilities[cap_idx]; + struct NonmovingSegment *seg = cap->current_segments[alloca_idx]; if (p >= (P_)seg && p < (((P_)seg) + NONMOVING_SEGMENT_SIZE_W)) { return; } @@ -1352,33 +1356,16 @@ void nonmovingPrintSegment(struct NonmovingSegment *seg) debugBelch("End of segment\n\n"); } -void nonmovingPrintAllocator(struct NonmovingAllocator *alloc) -{ - debugBelch("Allocator at %p\n", (void*)alloc); - debugBelch("Filled segments:\n"); - for (struct NonmovingSegment *seg = alloc->filled; seg != NULL; seg = seg->link) { - debugBelch("%p ", (void*)seg); - } - debugBelch("\nActive segments:\n"); - for (struct NonmovingSegment *seg = alloc->active; seg != NULL; seg = seg->link) { - debugBelch("%p ", (void*)seg); - } - debugBelch("\nCurrent segments:\n"); - for (uint32_t i = 0; i < getNumCapabilities(); ++i) { - debugBelch("%p ", alloc->current[i]); - } - debugBelch("\n"); -} - void locate_object(P_ obj) { // Search allocators for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { - struct NonmovingAllocator *alloca = nonmovingHeap.allocators[alloca_idx]; - for (uint32_t cap = 0; cap < getNumCapabilities(); ++cap) { - struct NonmovingSegment *seg = alloca->current[cap]; + struct NonmovingAllocator *alloca = &nonmovingHeap.allocators[alloca_idx]; + for (uint32_t cap_n = 0; cap_n < nonmovingHeap.n_caps; ++cap_n) { + Capability *cap = capabilities[cap_n]; + struct NonmovingSegment *seg = cap->current_segments[alloca_idx]; if (obj >= (P_)seg && obj < (((P_)seg) + NONMOVING_SEGMENT_SIZE_W)) { - debugBelch("%p is in current segment of capability %d of allocator %d at %p\n", obj, cap, alloca_idx, (void*)seg); + debugBelch("%p is in current segment of capability %d of allocator %d at %p\n", obj, cap_n, alloca_idx, (void*)seg); return; } } ===================================== rts/sm/NonMoving.h ===================================== @@ -84,8 +84,7 @@ struct NonmovingAllocator { struct NonmovingSegment *filled; struct NonmovingSegment *saved_filled; struct NonmovingSegment *active; - // indexed by capability number - struct NonmovingSegment *current[]; + // N.B. Per-capabilty "current" segment lives in Capability }; // first allocator is of size 2^NONMOVING_ALLOCA0 (in bytes) @@ -99,7 +98,7 @@ struct NonmovingAllocator { #define NONMOVING_MAX_FREE 16 struct NonmovingHeap { - struct NonmovingAllocator *allocators[NONMOVING_ALLOCA_CNT]; + struct NonmovingAllocator allocators[NONMOVING_ALLOCA_CNT]; // free segment list. This is a cache where we keep up to // NONMOVING_MAX_FREE segments to avoid thrashing the block allocator. // Note that segments in this list are still counted towards @@ -149,7 +148,7 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads); void *nonmovingAllocate(Capability *cap, StgWord sz); -void nonmovingAddCapabilities(uint32_t new_n_caps); +void nonmovingInitCapability(Capability *cap); void nonmovingPushFreeSegment(struct NonmovingSegment *seg); void nonmovingClearBitmap(struct NonmovingSegment *seg); @@ -166,7 +165,7 @@ INLINE_HEADER uint8_t nonmovingSegmentLogBlockSize(struct NonmovingSegment *seg) INLINE_HEADER void nonmovingPushActiveSegment(struct NonmovingSegment *seg) { struct NonmovingAllocator *alloc = - nonmovingHeap.allocators[nonmovingSegmentLogBlockSize(seg) - NONMOVING_ALLOCA0]; + &nonmovingHeap.allocators[nonmovingSegmentLogBlockSize(seg) - NONMOVING_ALLOCA0]; SET_SEGMENT_STATE(seg, ACTIVE); while (true) { struct NonmovingSegment *current_active = (struct NonmovingSegment*)VOLATILE_LOAD(&alloc->active); @@ -181,7 +180,7 @@ INLINE_HEADER void nonmovingPushActiveSegment(struct NonmovingSegment *seg) INLINE_HEADER void nonmovingPushFilledSegment(struct NonmovingSegment *seg) { struct NonmovingAllocator *alloc = - nonmovingHeap.allocators[nonmovingSegmentLogBlockSize(seg) - NONMOVING_ALLOCA0]; + &nonmovingHeap.allocators[nonmovingSegmentLogBlockSize(seg) - NONMOVING_ALLOCA0]; SET_SEGMENT_STATE(seg, FILLED); while (true) { struct NonmovingSegment *current_filled = (struct NonmovingSegment*)VOLATILE_LOAD(&alloc->filled); @@ -289,20 +288,17 @@ INLINE_HEADER void nonmovingSetClosureMark(StgPtr p) nonmovingSetMark(nonmovingGetSegment(p), nonmovingGetBlockIdx(p)); } -// TODO: Audit the uses of these -/* Was the given closure marked this major GC cycle? */ -INLINE_HEADER bool nonmovingClosureMarkedThisCycle(StgPtr p) +INLINE_HEADER uint8_t nonmovingGetClosureMark(StgPtr p) { struct NonmovingSegment *seg = nonmovingGetSegment(p); nonmoving_block_idx blk_idx = nonmovingGetBlockIdx(p); - return nonmovingGetMark(seg, blk_idx) == nonmovingMarkEpoch; + return nonmovingGetMark(seg, blk_idx); } -INLINE_HEADER bool nonmovingClosureMarked(StgPtr p) +/* Was the given closure marked this major GC cycle? */ +INLINE_HEADER bool nonmovingClosureMarkedThisCycle(StgPtr p) { - struct NonmovingSegment *seg = nonmovingGetSegment(p); - nonmoving_block_idx blk_idx = nonmovingGetBlockIdx(p); - return nonmovingGetMark(seg, blk_idx) != 0; + return nonmovingGetClosureMark(p) == nonmovingMarkEpoch; } // Can be called during a major collection to determine whether a particular @@ -336,10 +332,14 @@ INLINE_HEADER bool nonmovingClosureBeingSwept(StgClosure *p) } } +// N.B. RtsFlags is defined as a pointer in STG code consequently this code +// doesn't typecheck. +#if !IN_STG_CODE INLINE_HEADER bool isNonmovingClosure(StgClosure *p) { - return !HEAP_ALLOCED_GC(p) || Bdescr((P_)p)->flags & BF_NONMOVING; + return RtsFlags.GcFlags.useNonmoving && (!HEAP_ALLOCED_GC(p) || Bdescr((P_)p)->flags & BF_NONMOVING); } +#endif #if defined(DEBUG) ===================================== rts/sm/NonMovingCensus.c ===================================== @@ -21,10 +21,12 @@ // stopped. In this case is safe to look at active and current segments so we can // also collect statistics on live words. static struct NonmovingAllocCensus -nonmovingAllocatorCensus_(struct NonmovingAllocator *alloc, bool collect_live_words) +nonmovingAllocatorCensus_(uint32_t alloc_idx, bool collect_live_words) { struct NonmovingAllocCensus census = {collect_live_words, 0, 0, 0, 0}; + struct NonmovingAllocator *alloc = &nonmovingHeap.allocators[alloc_idx]; + // filled segments for (struct NonmovingSegment *seg = alloc->filled; seg != NULL; seg = seg->link) @@ -40,6 +42,7 @@ nonmovingAllocatorCensus_(struct NonmovingAllocator *alloc, bool collect_live_wo } } + // active segments for (struct NonmovingSegment *seg = alloc->active; seg != NULL; seg = seg->link) @@ -56,9 +59,11 @@ nonmovingAllocatorCensus_(struct NonmovingAllocator *alloc, bool collect_live_wo } } - for (unsigned int cap=0; cap < getNumCapabilities(); cap++) + // current segments + for (unsigned int cap_n=0; cap_n < getNumCapabilities(); cap_n++) { - struct NonmovingSegment *seg = alloc->current[cap]; + Capability *cap = capabilities[cap_n]; + struct NonmovingSegment *seg = cap->current_segments[alloc_idx]; unsigned int n = nonmovingSegmentBlockCount(seg); for (unsigned int i=0; i < n; i++) { if (nonmovingGetMark(seg, i)) { @@ -76,15 +81,15 @@ nonmovingAllocatorCensus_(struct NonmovingAllocator *alloc, bool collect_live_wo * all blocks in nonmoving heap are valid closures. */ struct NonmovingAllocCensus -nonmovingAllocatorCensusWithWords(struct NonmovingAllocator *alloc) +nonmovingAllocatorCensusWithWords(uint32_t alloc_idx) { - return nonmovingAllocatorCensus_(alloc, true); + return nonmovingAllocatorCensus_(alloc_idx, true); } struct NonmovingAllocCensus -nonmovingAllocatorCensus(struct NonmovingAllocator *alloc) +nonmovingAllocatorCensus(uint32_t alloc_idx) { - return nonmovingAllocatorCensus_(alloc, false); + return nonmovingAllocatorCensus_(alloc_idx, false); } @@ -130,7 +135,7 @@ void nonmovingPrintAllocatorCensus(bool collect_live_words) for (int i=0; i < NONMOVING_ALLOCA_CNT; i++) { struct NonmovingAllocCensus census = - nonmovingAllocatorCensus_(nonmovingHeap.allocators[i], collect_live_words); + nonmovingAllocatorCensus_(i, collect_live_words); print_alloc_census(i, census); } @@ -143,8 +148,7 @@ void nonmovingTraceAllocatorCensus() return; for (int i=0; i < NONMOVING_ALLOCA_CNT; i++) { - const struct NonmovingAllocCensus census = - nonmovingAllocatorCensus(nonmovingHeap.allocators[i]); + const struct NonmovingAllocCensus census = nonmovingAllocatorCensus(i); const uint32_t log_blk_size = i + NONMOVING_ALLOCA0; traceNonmovingHeapCensus(log_blk_size, &census); } ===================================== rts/sm/NonMovingCensus.h ===================================== @@ -20,10 +20,10 @@ struct NonmovingAllocCensus { struct NonmovingAllocCensus -nonmovingAllocatorCensusWithWords(struct NonmovingAllocator *alloc); +nonmovingAllocatorCensusWithWords(uint32_t alloc_idx); struct NonmovingAllocCensus -nonmovingAllocatorCensus(struct NonmovingAllocator *alloc); +nonmovingAllocatorCensus(uint32_t alloc_idx); void nonmovingPrintAllocatorCensus(bool collect_live_words); void nonmovingTraceAllocatorCensus(void); ===================================== rts/sm/NonMovingMark.c ===================================== @@ -39,6 +39,9 @@ static void trace_PAP_payload (MarkQueue *queue, StgClosure *fun, StgClosure **payload, StgWord size); +#if defined(DEBUG) +static bool is_nonmoving_weak(StgWeak *weak); +#endif // How many Array# entries to add to the mark queue at once? #define MARK_ARRAY_CHUNK_LENGTH 128 @@ -254,7 +257,7 @@ StgWord nonmoving_write_barrier_enabled = false; MarkQueue *current_mark_queue = NULL; /* Initialise update remembered set data structures */ -void nonmovingMarkInitUpdRemSet() { +void nonmovingMarkInit() { #if defined(THREADED_RTS) initMutex(&upd_rem_set_lock); initCondition(&upd_rem_set_flushed_cond); @@ -274,6 +277,7 @@ static void nonmovingAddUpdRemSetBlocks_(MarkQueue *rset) bdescr *end = start; while (end->link != NULL) end = end->link; + rset->blocks = NULL; // add the blocks to the global remembered set ACQUIRE_LOCK(&upd_rem_set_lock); @@ -297,8 +301,8 @@ static void nonmovingAddUpdRemSetBlocks_lock(MarkQueue *rset) // Reset the state of the remembered set. ACQUIRE_SM_LOCK; init_mark_queue_(rset); - rset->is_upd_rem_set = true; RELEASE_SM_LOCK; + rset->is_upd_rem_set = true; } /* @@ -651,6 +655,16 @@ void updateRemembSetPushThunkEager(Capability *cap, } break; } + case THUNK_SELECTOR: + { + StgSelector *sel = (StgSelector *) thunk; + if (check_in_nonmoving_heap(sel->selectee)) { + // Don't bother to push origin; it makes the barrier needlessly + // expensive with little benefit. + push_closure(queue, sel->selectee, NULL); + } + break; + } case AP: { StgAP *ap = (StgAP *) thunk; @@ -660,9 +674,11 @@ void updateRemembSetPushThunkEager(Capability *cap, trace_PAP_payload(queue, ap->fun, ap->payload, ap->n_args); break; } - case THUNK_SELECTOR: + // We may end up here if a thunk update races with another update. + // In this case there is nothing to do as the other thread will have + // already pushed the updated thunk's free variables to the update + // remembered set. case BLACKHOLE: - // TODO: This is right, right? break; // The selector optimization performed by the nonmoving mark may have // overwritten a thunk which we are updating with an indirection. @@ -909,6 +925,7 @@ static MarkQueueEnt markQueuePop (MarkQueue *q) static void init_mark_queue_ (MarkQueue *queue) { bdescr *bd = allocGroup(MARK_QUEUE_BLOCKS); + ASSERT(queue->blocks == NULL); queue->blocks = bd; queue->top = (MarkQueueBlock *) bd->start; queue->top->head = 0; @@ -1293,8 +1310,11 @@ mark_closure (MarkQueue *queue, const StgClosure *p0, StgClosure **origin) goto done; case WHITEHOLE: - while (*(StgInfoTable* volatile*) &p->header.info == &stg_WHITEHOLE_info); - // busy_wait_nop(); // FIXME + while (*(StgInfoTable* volatile*) &p->header.info == &stg_WHITEHOLE_info) +#if defined(PARALLEL_GC) + busy_wait_nop() +#endif + ; goto try_again; default: @@ -1502,10 +1522,12 @@ mark_closure (MarkQueue *queue, const StgClosure *p0, StgClosure **origin) break; } + case WEAK: + ASSERT(is_nonmoving_weak((StgWeak*) p)); + // fallthrough gen_obj: case CONSTR: case CONSTR_NOCAF: - case WEAK: case PRIM: { for (StgWord i = 0; i < info->layout.payload.ptrs; i++) { @@ -1558,8 +1580,15 @@ mark_closure (MarkQueue *queue, const StgClosure *p0, StgClosure **origin) } case THUNK_SELECTOR: - nonmoving_eval_thunk_selector(queue, (StgSelector*)p, origin); + { + StgSelector *sel = (StgSelector *) p; + // We may be able to evaluate this selector which may render the + // selectee unreachable. However, we must mark the selectee regardless + // to satisfy the snapshot invariant. + PUSH_FIELD(sel, selectee); + nonmoving_eval_thunk_selector(queue, sel, origin); break; + } case AP_STACK: { StgAP_STACK *ap = (StgAP_STACK *)p; @@ -1709,15 +1738,23 @@ done: * b. the nursery has been fully evacuated into the non-moving generation. * c. the mark queue has been seeded with a set of roots. * + * If budget is not UNLIMITED_MARK_BUDGET, then we will mark no more than the + * indicated number of objects and deduct the work done from the budget. */ GNUC_ATTR_HOT void -nonmovingMark (MarkQueue *queue) +nonmovingMark (MarkBudget* budget, MarkQueue *queue) { traceConcMarkBegin(); debugTrace(DEBUG_nonmoving_gc, "Starting mark pass"); - unsigned int count = 0; + uint64_t count = 0; while (true) { count++; + if (*budget == 0) { + return; + } else if (*budget != UNLIMITED_MARK_BUDGET) { + *budget -= 1; + } + MarkQueueEnt ent = markQueuePop(queue); switch (nonmovingMarkQueueEntryType(&ent)) { @@ -1846,20 +1883,66 @@ static bool nonmovingIsNowAlive (StgClosure *p) bdescr *bd = Bdescr((P_)p); - // All non-static objects in the non-moving heap should be marked as - // BF_NONMOVING - ASSERT(bd->flags & BF_NONMOVING); + const uint16_t flags = bd->flags; + if (flags & BF_LARGE) { + if (flags & BF_PINNED && !(flags & BF_NONMOVING)) { + // In this case we have a pinned object living in a non-full + // accumulator block which was not promoted to the nonmoving + // generation. Assume that the object is alive. + // See #22014. + return true; + } - if (bd->flags & BF_LARGE) { + ASSERT(bd->flags & BF_NONMOVING); return (bd->flags & BF_NONMOVING_SWEEPING) == 0 // the large object wasn't in the snapshot and therefore wasn't marked || (bd->flags & BF_MARKED) != 0; // The object was marked } else { - return nonmovingClosureMarkedThisCycle((P_)p); + // All non-static objects in the non-moving heap should be marked as + // BF_NONMOVING. + ASSERT(bd->flags & BF_NONMOVING); + + struct NonmovingSegment *seg = nonmovingGetSegment((StgPtr) p); + StgClosure *snapshot_loc = + (StgClosure *) nonmovingSegmentGetBlock(seg, nonmovingSegmentInfo(seg)->next_free_snap); + if (p >= snapshot_loc && nonmovingGetClosureMark((StgPtr) p) == 0) { + /* + * In this case we are looking at a block that wasn't allocated + * at the time that the snapshot was taken. As we do not mark such + * blocks, we must assume that it is reachable. + */ + return true; + } else { + return nonmovingClosureMarkedThisCycle((P_)p); + } + } +} + +// Mark all Weak#s on nonmoving_old_weak_ptr_list. +void nonmovingMarkWeakPtrList (struct MarkQueue_ *queue) +{ + ASSERT(nonmoving_weak_ptr_list == NULL); + for (StgWeak *w = nonmoving_old_weak_ptr_list; w != NULL; w = w->link) { + mark_closure(queue, (StgClosure *) w, NULL); } } +// Determine whether a weak pointer object is on one of the nonmoving +// collector's weak pointer lists. Used for sanity checking. +#if defined(DEBUG) +static bool is_nonmoving_weak(StgWeak *weak) +{ + for (StgWeak *w = nonmoving_old_weak_ptr_list; w != NULL; w = w->link) { + if (w == weak) return true; + } + for (StgWeak *w = nonmoving_weak_ptr_list; w != NULL; w = w->link) { + if (w == weak) return true; + } + return false; +} +#endif + // Non-moving heap variant of `tidyWeakList` bool nonmovingTidyWeaks (struct MarkQueue_ *queue) { @@ -1868,6 +1951,9 @@ bool nonmovingTidyWeaks (struct MarkQueue_ *queue) StgWeak **last_w = &nonmoving_old_weak_ptr_list; StgWeak *next_w; for (StgWeak *w = nonmoving_old_weak_ptr_list; w != NULL; w = next_w) { + // This should have been marked by nonmovingMarkWeaks + ASSERT(nonmovingIsNowAlive((StgClosure *) w)); + if (w->header.info == &stg_DEAD_WEAK_info) { // finalizeWeak# was called on the weak next_w = w->link; @@ -1878,7 +1964,10 @@ bool nonmovingTidyWeaks (struct MarkQueue_ *queue) // Otherwise it's a live weak ASSERT(w->header.info == &stg_WEAK_info); - if (nonmovingIsNowAlive(w->key)) { + // See Note [Weak pointer processing and the non-moving GC] in + // MarkWeak.c + bool key_in_nonmoving = Bdescr((StgPtr) w->key)->flags & BF_NONMOVING; + if (!key_in_nonmoving || nonmovingIsNowAlive(w->key)) { nonmovingMarkLiveWeak(queue, w); did_work = true; @@ -1886,7 +1975,7 @@ bool nonmovingTidyWeaks (struct MarkQueue_ *queue) *last_w = w->link; next_w = w->link; - // and put it on the weak ptr list + // and put it on nonmoving_weak_ptr_list w->link = nonmoving_weak_ptr_list; nonmoving_weak_ptr_list = w; } else { @@ -1908,7 +1997,8 @@ void nonmovingMarkDeadWeak (struct MarkQueue_ *queue, StgWeak *w) void nonmovingMarkLiveWeak (struct MarkQueue_ *queue, StgWeak *w) { - ASSERT(nonmovingClosureMarkedThisCycle((P_)w)); + ASSERT(nonmovingIsNowAlive((StgClosure *) w)); + ASSERT(nonmovingIsNowAlive((StgClosure *) w->key)); markQueuePushClosure_(queue, w->value); markQueuePushClosure_(queue, w->finalizer); markQueuePushClosure_(queue, w->cfinalizers); @@ -1922,9 +2012,9 @@ void nonmovingMarkDeadWeaks (struct MarkQueue_ *queue, StgWeak **dead_weaks) { StgWeak *next_w; for (StgWeak *w = nonmoving_old_weak_ptr_list; w; w = next_w) { - ASSERT(!nonmovingClosureMarkedThisCycle((P_)(w->key))); + ASSERT(!nonmovingIsNowAlive(w->key)); nonmovingMarkDeadWeak(queue, w); - next_w = w ->link; + next_w = w->link; w->link = *dead_weaks; *dead_weaks = w; } ===================================== rts/sm/NonMovingMark.h ===================================== @@ -111,6 +111,11 @@ typedef struct { MarkQueue queue; } UpdRemSet; +// How much marking work we are allowed to perform +// See Note [Sync phase marking budget] in NonMoving.c +typedef int64_t MarkBudget; +#define UNLIMITED_MARK_BUDGET INT64_MIN + // Number of blocks to allocate for a mark queue #define MARK_QUEUE_BLOCKS 16 @@ -135,7 +140,7 @@ extern MarkQueue *current_mark_queue; extern bdescr *upd_rem_set_block_list; -void nonmovingMarkInitUpdRemSet(void); +void nonmovingMarkInit(void); void nonmovingInitUpdRemSet(UpdRemSet *rset); void updateRemembSetPushClosure(Capability *cap, StgClosure *p); @@ -154,8 +159,13 @@ void markQueueAddRoot(MarkQueue* q, StgClosure** root); void initMarkQueue(MarkQueue *queue); void freeMarkQueue(MarkQueue *queue); -void nonmovingMark(struct MarkQueue_ *restrict queue); +void nonmovingMark(MarkBudget *budget, struct MarkQueue_ *restrict queue); +INLINE_HEADER void nonmovingMarkUnlimitedBudget(struct MarkQueue_ *restrict queue) { + MarkBudget budget = UNLIMITED_MARK_BUDGET; + nonmovingMark(&budget, queue); +} +void nonmovingMarkWeakPtrList(struct MarkQueue_ *queue); bool nonmovingTidyWeaks(struct MarkQueue_ *queue); void nonmovingTidyThreads(void); void nonmovingMarkDeadWeaks(struct MarkQueue_ *queue, StgWeak **dead_weak_ptr_list); ===================================== rts/sm/Sanity.c ===================================== @@ -619,11 +619,12 @@ static void checkNonmovingSegments (struct NonmovingSegment *seg) void checkNonmovingHeap (const struct NonmovingHeap *heap) { for (unsigned int i=0; i < NONMOVING_ALLOCA_CNT; i++) { - const struct NonmovingAllocator *alloc = heap->allocators[i]; + const struct NonmovingAllocator *alloc = &heap->allocators[i]; checkNonmovingSegments(alloc->filled); checkNonmovingSegments(alloc->active); - for (unsigned int cap=0; cap < getNumCapabilities(); cap++) { - checkNonmovingSegments(alloc->current[cap]); + for (unsigned int cap_n=0; cap_n < getNumCapabilities(); cap_n++) { + Capability *cap = capabilities[cap_n]; + checkNonmovingSegments(cap->current_segments[i]); } } } @@ -1047,11 +1048,12 @@ findMemoryLeak (void) markBlocks(nonmoving_compact_objects); markBlocks(nonmoving_marked_compact_objects); for (i = 0; i < NONMOVING_ALLOCA_CNT; i++) { - struct NonmovingAllocator *alloc = nonmovingHeap.allocators[i]; + struct NonmovingAllocator *alloc = &nonmovingHeap.allocators[i]; markNonMovingSegments(alloc->filled); markNonMovingSegments(alloc->active); for (j = 0; j < getNumCapabilities(); j++) { - markNonMovingSegments(alloc->current[j]); + Capability *cap = capabilities[j]; + markNonMovingSegments(cap->current_segments[i]); } } markNonMovingSegments(nonmovingHeap.sweep_list); @@ -1156,23 +1158,18 @@ countNonMovingSegments(struct NonmovingSegment *segs) return ret; } -static W_ -countNonMovingAllocator(struct NonmovingAllocator *alloc) -{ - W_ ret = countNonMovingSegments(alloc->filled) - + countNonMovingSegments(alloc->active); - for (uint32_t i = 0; i < getNumCapabilities(); ++i) { - ret += countNonMovingSegments(alloc->current[i]); - } - return ret; -} - static W_ countNonMovingHeap(struct NonmovingHeap *heap) { W_ ret = 0; for (int alloc_idx = 0; alloc_idx < NONMOVING_ALLOCA_CNT; alloc_idx++) { - ret += countNonMovingAllocator(heap->allocators[alloc_idx]); + struct NonmovingAllocator *alloc = &heap->allocators[alloc_idx]; + ret += countNonMovingSegments(alloc->filled); + ret += countNonMovingSegments(alloc->active); + for (uint32_t c = 0; c < getNumCapabilities(); ++c) { + Capability *cap = capabilities[c]; + ret += countNonMovingSegments(cap->current_segments[alloc_idx]); + } } ret += countNonMovingSegments(heap->sweep_list); ret += countNonMovingSegments(heap->free); ===================================== rts/sm/Storage.c ===================================== @@ -214,17 +214,14 @@ initStorage (void) } oldest_gen->to = oldest_gen; - // Nonmoving heap uses oldest_gen so initialize it after initializing oldest_gen - nonmovingInit(); - #if defined(THREADED_RTS) // nonmovingAddCapabilities allocates segments, which requires taking the gc // sync lock, so initialize it before nonmovingAddCapabilities initSpinLock(&gc_alloc_block_sync); #endif - if (RtsFlags.GcFlags.useNonmoving) - nonmovingAddCapabilities(getNumCapabilities()); + // Nonmoving heap uses oldest_gen so initialize it after initializing oldest_gen + nonmovingInit(); /* The oldest generation has one step. */ if (RtsFlags.GcFlags.compact || RtsFlags.GcFlags.sweep) { @@ -320,11 +317,10 @@ void storageAddCapabilities (uint32_t from, uint32_t to) } } - // Initialize NonmovingAllocators and UpdRemSets + // Initialize non-moving collector if (RtsFlags.GcFlags.useNonmoving) { - nonmovingAddCapabilities(to); - for (i = 0; i < to; ++i) { - nonmovingInitUpdRemSet(&capabilities[i]->upd_rem_set); + for (i = from; i < to; i++) { + nonmovingInitCapability(capabilities[i]); } } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/10e43f7d3f31badae0bd11d12ec145840d9b259b...edaab7241274f79792fa71676aad54033c0d0ab2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/10e43f7d3f31badae0bd11d12ec145840d9b259b...edaab7241274f79792fa71676aad54033c0d0ab2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 13:36:06 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Wed, 08 Feb 2023 08:36:06 -0500 Subject: [Git][ghc/ghc][wip/9.2.6-backports] 16 commits: nonmoving: Fix handling of weak pointers Message-ID: <63e3a5467a82c_730ce54970161180@gitlab.mail> Zubin pushed to branch wip/9.2.6-backports at Glasgow Haskell Compiler / GHC Commits: d377b9b4 by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. (cherry picked from commit a999f7b5b4b7316c088d7233a452fb33dc17646f) - - - - - f463d9e4 by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. (cherry picked from commit 48b89dba91640fa977d038ea5283019c73f1b18e) - - - - - c7f6cc07 by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Handle new closures in nonmovingIsNowAlive (cherry picked from commit 36ca160d0f199a688cf5fbc91d4bb92d2d4ea14e) - - - - - e2a81e2a by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. (cherry picked from commit 8b64aff0fa978c762dfae8df235dd2b2a340656a) - - - - - 8aceb849 by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. (cherry picked from commit dde67d6e32ecff0e400f98213d42ae790babac09) - - - - - 12761253 by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Don't push if nonmoving collector isn't enabled (cherry picked from commit 8adc1750c02e596b4014d2837b4eb3d76bd130f2) - - - - - 41c8db24 by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. (cherry picked from commit c620669651c52fd228af61040747dd7236c4ba2b) - - - - - cf1921ab by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Allow pinned gen0 objects to be WEAK keys (cherry picked from commit 3887132fcd20f0a1edfc9f7006bdbed2634e2a8d) - - - - - 639329fe by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. (cherry picked from commit cc75031b4d93d4565e0428cb5910d9b9a645485b) - - - - - 764145d7 by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Add missing no-op in busy-wait loop (cherry picked from commit 9f931a8801c84b8ae473f91349e144eebc73b415) - - - - - 71adc788 by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Move current segment array into Capability (cherry picked from commit 9d245c1baec91ee79d715062b127e487456d9c9e) - - - - - 85a080e9 by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. (cherry picked from commit 6bdce35cdd59112a8cb4a4a3b061e854ada3ff63) - - - - - 5721baa1 by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Fix unregisterised build (cherry picked from commit 6df2709e7215ea80d7267800e0318aee2a7c277f) - - - - - 98802ef8 by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Avoid n_caps race (cherry picked from commit c00d6de815d4e125c1c4d8ff06549042f502f759) - - - - - d5291cff by Ben Gamari at 2023-02-08T19:05:11+05:30 relnotes: Mention various non-moving GC fixes - - - - - 06a4a65f by Zubin Duggal at 2023-02-08T19:05:11+05:30 testsuite: Mark T9405 as fixed on windows - - - - - 17 changed files: - docs/users_guide/9.2.6-notes.rst - rts/Capability.c - rts/Capability.h - rts/RtsStartup.c - rts/Schedule.c - rts/sm/Evac.c - rts/sm/GC.c - rts/sm/MarkWeak.c - rts/sm/NonMoving.c - rts/sm/NonMoving.h - rts/sm/NonMovingCensus.c - rts/sm/NonMovingCensus.h - rts/sm/NonMovingMark.c - rts/sm/NonMovingMark.h - rts/sm/Sanity.c - rts/sm/Storage.c - testsuite/tests/rts/all.T Changes: ===================================== docs/users_guide/9.2.6-notes.rst ===================================== @@ -66,6 +66,23 @@ Runtime system - Truncate eventlog events with a large payload (:ghc-ticket:`20221`). +- A bug in the nonmoving garbage collector regarding the treatment of + zero-length ``SmallArray#``\ s has been fixed (:ghc-ticket:`22264`) + +- A number of bugs regarding the non-moving garbage collector's treatment of + ``Weak#`` pointers have been fixed (:ghc-ticket:`22327`) + +- A few race conditions between the non-moving collector and + ``setNumCapabilities`` which could result in undefined behavior have been + fixed (:ghc-ticket:`22926`, :ghc-ticket:`22927`) + +- The non-moving collector is now able to better schedule marking work during + the post-mark synchronization phase of collection, significantly reducing + pause times in some workloads (:ghc-ticket:`22929`). + +- Various bugs in the non-moving collector's implementation of the selector + optimisation have been fixed (:ghc-ticket:`22930`) + Build system and packaging -------------------------- ===================================== rts/Capability.c ===================================== @@ -294,6 +294,7 @@ initCapability (Capability *cap, uint32_t i) cap->saved_mut_lists = stgMallocBytes(sizeof(bdescr *) * RtsFlags.GcFlags.generations, "initCapability"); + cap->current_segments = NULL; // At this point storage manager is not initialized yet, so this will be @@ -1267,6 +1268,9 @@ freeCapability (Capability *cap) { stgFree(cap->mut_lists); stgFree(cap->saved_mut_lists); + if (cap->current_segments) { + stgFree(cap->current_segments); + } #if defined(THREADED_RTS) freeSparkPool(cap->sparks); #endif ===================================== rts/Capability.h ===================================== @@ -88,6 +88,9 @@ struct Capability_ { // The update remembered set for the non-moving collector UpdRemSet upd_rem_set; + // Array of current segments for the non-moving collector. + // Of length NONMOVING_ALLOCA_CNT. + struct NonmovingSegment **current_segments; // block for allocating pinned objects into bdescr *pinned_object_block; ===================================== rts/RtsStartup.c ===================================== @@ -472,6 +472,7 @@ hs_exit_(bool wait_foreign) for (g = 0; g < RtsFlags.GcFlags.generations; g++) { runAllCFinalizers(generations[g].weak_ptr_list); } + runAllCFinalizers(nonmoving_weak_ptr_list); #if defined(RTS_USER_SIGNALS) if (RtsFlags.MiscFlags.install_signal_handlers) { ===================================== rts/Schedule.c ===================================== @@ -1710,7 +1710,9 @@ scheduleDoGC (Capability **pcap, Task *task USED_IF_THREADS, stat_startGCSync(gc_threads[cap->no]); +#if defined(DEBUG) unsigned int old_n_capabilities = getNumCapabilities(); +#endif interruptAllCapabilities(); @@ -2306,7 +2308,9 @@ setNumCapabilities (uint32_t new_n_capabilities USED_IF_THREADS) moreCapabilities(n_capabilities, new_n_capabilities); // Resize and update storage manager data structures + ACQUIRE_SM_LOCK; storageAddCapabilities(n_capabilities, new_n_capabilities); + RELEASE_SM_LOCK; } } ===================================== rts/sm/Evac.c ===================================== @@ -1254,6 +1254,10 @@ selector_chain: uint16_t flags = RELAXED_LOAD(&bd->flags); if (flags & (BF_EVACUATED | BF_NONMOVING)) { unchain_thunk_selectors(prev_thunk_selector, (StgClosure *)p); + if (flags & BF_NONMOVING) { + // See Note [Non-moving GC: Marking evacuated objects]. + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure*) p); + } *q = (StgClosure *)p; // shortcut, behave as for: if (evac) evacuate(q); if (evac && bd->gen_no < gct->evac_gen_no) { @@ -1308,6 +1312,12 @@ selector_chain: // - undo the chain we've built to point to p. SET_INFO((StgClosure *)p, (const StgInfoTable *)info_ptr); RELEASE_STORE(q, (StgClosure *) p); + if (Bdescr((StgPtr)p)->flags & BF_NONMOVING) { + // See Note [Non-moving GC: Marking evacuated objects]. + // TODO: This really shouldn't be necessary since whoever won + // the race should have pushed + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure*) p); + } if (evac) evacuate(q); unchain_thunk_selectors(prev_thunk_selector, (StgClosure *)p); return; @@ -1398,6 +1408,11 @@ selector_loop: case THUNK_SELECTOR: // Use payload to make a list of thunk selectors, to be // used in unchain_thunk_selectors + // + // FIXME: This seems racy; should we lock this selector to + // ensure that another thread doesn't clobber this node + // of the chain. This would result in some previous + // selectors not being updated when we unchain. RELAXED_STORE(&((StgClosure*)p)->payload[0], (StgClosure *)prev_thunk_selector); prev_thunk_selector = p; p = (StgSelector*)val; @@ -1422,6 +1437,12 @@ selector_loop: // eval_thunk_selector(), because we know val is not // a THUNK_SELECTOR. if (evac) evacuate(q); + + if (isNonmovingClosure(*q)) { + // See Note [Non-moving GC: Marking evacuated objects]. + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure*) *q); + } + return; } @@ -1466,6 +1487,10 @@ selector_loop: // recurse indefinitely, so we impose a depth bound. // See Note [Selector optimisation depth limit]. if (gct->thunk_selector_depth >= MAX_THUNK_SELECTOR_DEPTH) { + if (isNonmovingClosure((StgClosure *) p)) { + // See Note [Non-moving GC: Marking evacuated objects]. + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure*) p); + } goto bale_out; } @@ -1512,5 +1537,9 @@ bale_out: if (evac) { copy(q,(const StgInfoTable *)info_ptr,(StgClosure *)p,THUNK_SELECTOR_sizeW(),bd->dest_no); } + if (isNonmovingClosure(*q)) { + // See Note [Non-moving GC: Marking evacuated objects]. + markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, *q); + } unchain_thunk_selectors(prev_thunk_selector, *q); } ===================================== rts/sm/GC.c ===================================== @@ -375,7 +375,8 @@ GarbageCollect (uint32_t collect_gen, static_flag == STATIC_FLAG_A ? STATIC_FLAG_B : STATIC_FLAG_A; } - if (major_gc) { + /* N.B. We currently don't unload code with the non-moving collector. */ + if (major_gc && !RtsFlags.GcFlags.useNonmoving) { unload_mark_needed = prepareUnloadCheck(); } else { unload_mark_needed = false; ===================================== rts/sm/MarkWeak.c ===================================== @@ -50,7 +50,7 @@ - weak_stage == WeakPtrs - We process all the weak pointers whos keys are alive (evacuate + We process all the weak pointers whose keys are alive (evacuate their values and finalizers), and repeat until we can find no new live keys. If no live keys are found in this pass, then we evacuate the finalizers of all the dead weak pointers in order to @@ -82,12 +82,46 @@ static bool tidyWeakList (generation *gen); static bool resurrectUnreachableThreads (generation *gen, StgTSO **resurrected_threads); static void tidyThreadList (generation *gen); +/* + * Note [Weak pointer processing and the non-moving GC] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * When using the non-moving GC we defer weak pointer processing + * until the concurrent marking phase as weaks in the non-moving heap may be + * keyed on objects living in the non-moving generation. To accomplish this + * initWeakForGC keeps all weak pointers on oldest_gen->weak_ptr_list, where + * nonmovingCollect will find them. From there they will be moved to + * nonmoving_old_weak_ptr_list. During the mark loop we will move weaks with + * reachable keys to nonmoving_weak_ptr_list. At the end of concurrent marking + * we tidy the weak list (in nonmovingTidyWeakList) and perform another set of + * marking as necessary, just as is done in tidyWeakList. + * + * Note that this treatment takes advantage of the fact that we usually need + * not worry about Weak#s living in the non-moving heap but being keyed on an + * object in the moving heap since the Weak# must be strictly older than the + * key. Such objects would otherwise pose a problem since the non-moving + * collector would be unable to safely determine the liveness of the key. + * In the rare case that we *do* see such a key (e.g. in the case of a + * pinned ByteArray# living in a partially-filled accumulator block) + * the nonmoving collector assumes that it is live. + * + */ + +/* + * Prepare the weak object lists for GC. Specifically, reset weak_stage + * and move all generations' `weak_ptr_list`s to `old_weak_ptr_list`. + * Weaks with live keys will later be moved back to `weak_ptr_list` by + * `tidyWeakList`. + */ void initWeakForGC(void) { - uint32_t g; + uint32_t oldest = N; + if (RtsFlags.GcFlags.useNonmoving && N == oldest_gen->no) { + // See Note [Weak pointer processing and the non-moving GC]. + oldest = oldest_gen->no - 1; + } - for (g = 0; g <= N; g++) { + for (uint32_t g = 0; g <= oldest; g++) { generation *gen = &generations[g]; gen->old_weak_ptr_list = gen->weak_ptr_list; gen->weak_ptr_list = NULL; @@ -96,6 +130,14 @@ initWeakForGC(void) weak_stage = WeakThreads; } +/* + * Walk the weak pointer lists after having finished a round of scavenging, + * tidying the weak (and possibly thread) lists (depending upon the current + * weak_stage). + * + * Returns true if new live weak pointers were found, implying that another + * round of scavenging is necessary. + */ bool traverseWeakPtrList(StgWeak **dead_weak_ptr_list, StgTSO **resurrected_threads) { @@ -182,6 +224,11 @@ traverseWeakPtrList(StgWeak **dead_weak_ptr_list, StgTSO **resurrected_threads) } } +/* + * Deal with weak pointers with unreachable keys after GC has concluded. + * This means marking the finalizer (and possibly value) in preparation for + * later finalization. + */ static void collectDeadWeakPtrs (generation *gen, StgWeak **dead_weak_ptr_list) { StgWeak *w, *next_w; @@ -198,6 +245,10 @@ static void collectDeadWeakPtrs (generation *gen, StgWeak **dead_weak_ptr_list) } } +/* + * Deal with threads left on the old_threads list after GC has concluded, + * moving them onto the resurrected_threads list where appropriate. + */ static bool resurrectUnreachableThreads (generation *gen, StgTSO **resurrected_threads) { StgTSO *t, *tmp, *next; @@ -233,8 +284,21 @@ static bool resurrectUnreachableThreads (generation *gen, StgTSO **resurrected_t return flag; } +/* + * Walk over the `old_weak_ptr_list` of the given generation and: + * + * - remove any DEAD_WEAKs + * - move any weaks with reachable keys to the `weak_ptr_list` of the + * appropriate to-space and mark the weak's value and finalizer. + */ static bool tidyWeakList(generation *gen) { + if (RtsFlags.GcFlags.useNonmoving && gen == oldest_gen) { + // See Note [Weak pointer processing and the non-moving GC]. + ASSERT(gen->old_weak_ptr_list == NULL); + return false; + } + StgWeak *w, **last_w, *next_w; const StgInfoTable *info; StgClosure *new; @@ -322,6 +386,10 @@ static bool tidyWeakList(generation *gen) return flag; } +/* + * Walk over the `old_threads` list of the given generation and move any + * reachable threads onto the `threads` list. + */ static void tidyThreadList (generation *gen) { StgTSO *t, *tmp, *next, **prev; @@ -381,6 +449,10 @@ static void checkWeakPtrSanity(StgWeak *hd, StgWeak *tl) } #endif +/* + * Traverse the capabilities' local new-weak-pointer lists at the beginning of + * GC and move them to the nursery's weak_ptr_list. + */ void collectFreshWeakPtrs() { uint32_t i; ===================================== rts/sm/NonMoving.c ===================================== @@ -244,6 +244,12 @@ Mutex concurrent_coll_finished_lock; * how we use the DIRTY flags associated with MUT_VARs and TVARs to improve * barrier efficiency. * + * - Note [Weak pointer processing and the non-moving GC] (MarkWeak.c) describes + * how weak pointers are handled when the non-moving GC is in use. + * + * - Note [Sync phase marking budget] describes how we avoid long mutator + * pauses during the sync phase + * * [ueno 2016]: * Katsuhiro Ueno and Atsushi Ohori. 2016. A fully concurrent garbage * collector for functional programs on multicore processors. SIGPLAN Not. 51, @@ -292,6 +298,7 @@ Mutex concurrent_coll_finished_lock; * ┆ * B ←────────────── A ←─────────────── root * │ ┆ ↖─────────────── gen1 mut_list + * │ ┆ * ╰───────────────→ C * ┆ * @@ -332,6 +339,7 @@ Mutex concurrent_coll_finished_lock; * The implementation details of this are described in Note [Non-moving GC: * Marking evacuated objects] in Evac.c. * + * * Note [Deadlock detection under the non-moving collector] * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ * In GHC the garbage collector is responsible for identifying deadlocked @@ -493,10 +501,44 @@ Mutex concurrent_coll_finished_lock; * remembered set during the preparatory GC. This allows us to safely skip the * non-moving write barrier without jeopardizing the snapshot invariant. * + * + * Note [Sync phase marking budget] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * The non-moving collector is intended to provide reliably low collection + * latencies. These latencies are primarily due to two sources: + * + * a. the preparatory moving collection at the beginning of the major GC cycle + * b. the post-mark synchronization pause at the end + * + * While the cost of (a) is inherently bounded by the young generation size, + * (b) can in principle be unbounded since the mutator may hide large swathes + * of heap from the collector's concurrent mark phase via mutation. These will + * only become visible to the collector during the post-mark synchronization + * phase. + * + * Since we don't want to do unbounded marking work in the pause, we impose a + * limit (specifically, sync_phase_marking_budget) on the amount of work + * (namely, the number of marked closures) that we can do during the pause. If + * we deplete our marking budget during the pause then we allow the mutators to + * resume and return to concurrent marking (keeping the update remembered set + * write barrier enabled). After we have finished marking we will again + * attempt the post-mark synchronization. + * + * The choice of sync_phase_marking_budget was made empirically. On 2022 + * hardware and a "typical" test program we tend to mark ~10^7 closures per + * second. Consequently, a sync_phase_marking_budget of 10^5 should produce + * ~10 ms pauses, which seems like a reasonable tradeoff. + * + * TODO: Perhaps sync_phase_marking_budget should be controllable via a + * command-line argument? + * */ memcount nonmoving_live_words = 0; +// See Note [Sync phase marking budget]. +MarkBudget sync_phase_marking_budget = 200000; + #if defined(THREADED_RTS) static void* nonmovingConcurrentMark(void *mark_queue); #endif @@ -665,10 +707,11 @@ void *nonmovingAllocate(Capability *cap, StgWord sz) // object and not moved) which is covered by allocator 9. ASSERT(log_block_size < NONMOVING_ALLOCA0 + NONMOVING_ALLOCA_CNT); - struct NonmovingAllocator *alloca = nonmovingHeap.allocators[log_block_size - NONMOVING_ALLOCA0]; + unsigned int alloca_idx = log_block_size - NONMOVING_ALLOCA0; + struct NonmovingAllocator *alloca = &nonmovingHeap.allocators[alloca_idx]; // Allocate into current segment - struct NonmovingSegment *current = alloca->current[cap->no]; + struct NonmovingSegment *current = cap->current_segments[alloca_idx]; ASSERT(current); // current is never NULL void *ret = nonmovingSegmentGetBlock_(current, log_block_size, current->next_free); ASSERT(GET_CLOSURE_TAG(ret) == 0); // check alignment @@ -701,29 +744,12 @@ void *nonmovingAllocate(Capability *cap, StgWord sz) // make it current new_current->link = NULL; SET_SEGMENT_STATE(new_current, CURRENT); - alloca->current[cap->no] = new_current; + cap->current_segments[alloca_idx] = new_current; } return ret; } -/* Allocate a nonmovingAllocator */ -static struct NonmovingAllocator *alloc_nonmoving_allocator(uint32_t n_caps) -{ - size_t allocator_sz = - sizeof(struct NonmovingAllocator) + - sizeof(void*) * n_caps; // current segment pointer for each capability - struct NonmovingAllocator *alloc = - stgMallocBytes(allocator_sz, "nonmovingInit"); - memset(alloc, 0, allocator_sz); - return alloc; -} - -static void free_nonmoving_allocator(struct NonmovingAllocator *alloc) -{ - stgFree(alloc); -} - void nonmovingInit(void) { if (! RtsFlags.GcFlags.useNonmoving) return; @@ -732,10 +758,7 @@ void nonmovingInit(void) initCondition(&concurrent_coll_finished); initMutex(&concurrent_coll_finished_lock); #endif - for (unsigned int i = 0; i < NONMOVING_ALLOCA_CNT; i++) { - nonmovingHeap.allocators[i] = alloc_nonmoving_allocator(getNumCapabilities()); - } - nonmovingMarkInitUpdRemSet(); + nonmovingMarkInit(); } // Stop any nonmoving collection in preparation for RTS shutdown. @@ -764,44 +787,24 @@ void nonmovingExit(void) closeCondition(&concurrent_coll_finished); closeMutex(&nonmoving_collection_mutex); #endif - - for (unsigned int i = 0; i < NONMOVING_ALLOCA_CNT; i++) { - free_nonmoving_allocator(nonmovingHeap.allocators[i]); - } } -/* - * Assumes that no garbage collector or mutator threads are running to safely - * resize the nonmoving_allocators. - * - * Must hold sm_mutex. - */ -void nonmovingAddCapabilities(uint32_t new_n_caps) +/* Initialize a new capability. Caller must hold SM_LOCK */ +void nonmovingInitCapability(Capability *cap) { - unsigned int old_n_caps = nonmovingHeap.n_caps; - struct NonmovingAllocator **allocs = nonmovingHeap.allocators; - + // Initialize current segment array + struct NonmovingSegment **segs = + stgMallocBytes(sizeof(struct NonmovingSegment*) * NONMOVING_ALLOCA_CNT, "current segment array"); for (unsigned int i = 0; i < NONMOVING_ALLOCA_CNT; i++) { - struct NonmovingAllocator *old = allocs[i]; - allocs[i] = alloc_nonmoving_allocator(new_n_caps); - - // Copy the old state - allocs[i]->filled = old->filled; - allocs[i]->active = old->active; - for (unsigned int j = 0; j < old_n_caps; j++) { - allocs[i]->current[j] = old->current[j]; - } - stgFree(old); - - // Initialize current segments for the new capabilities - for (unsigned int j = old_n_caps; j < new_n_caps; j++) { - allocs[i]->current[j] = nonmovingAllocSegment(capabilities[j]->node); - nonmovingInitSegment(allocs[i]->current[j], NONMOVING_ALLOCA0 + i); - SET_SEGMENT_STATE(allocs[i]->current[j], CURRENT); - allocs[i]->current[j]->link = NULL; - } + segs[i] = nonmovingAllocSegment(cap->node); + nonmovingInitSegment(segs[i], NONMOVING_ALLOCA0 + i); + SET_SEGMENT_STATE(segs[i], CURRENT); } - nonmovingHeap.n_caps = new_n_caps; + cap->current_segments = segs; + + // Initialize update remembered set + cap->upd_rem_set.queue.blocks = NULL; + nonmovingInitUpdRemSet(&cap->upd_rem_set); } void nonmovingClearBitmap(struct NonmovingSegment *seg) @@ -821,18 +824,21 @@ static void nonmovingPrepareMark(void) // Should have been cleared by the last sweep ASSERT(nonmovingHeap.sweep_list == NULL); + nonmovingHeap.n_caps = n_capabilities; nonmovingBumpEpoch(); for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { - struct NonmovingAllocator *alloca = nonmovingHeap.allocators[alloca_idx]; + struct NonmovingAllocator *alloca = &nonmovingHeap.allocators[alloca_idx]; // Update current segments' snapshot pointers - for (uint32_t cap_n = 0; cap_n < getNumCapabilities(); ++cap_n) { - struct NonmovingSegment *seg = alloca->current[cap_n]; + for (uint32_t cap_n = 0; cap_n < nonmovingHeap.n_caps; ++cap_n) { + Capability *cap = capabilities[cap_n]; + struct NonmovingSegment *seg = cap->current_segments[alloca_idx]; nonmovingSegmentInfo(seg)->next_free_snap = seg->next_free; } // Save the filled segments for later processing during the concurrent // mark phase. + ASSERT(alloca->saved_filled == NULL); alloca->saved_filled = alloca->filled; alloca->filled = NULL; @@ -886,44 +892,7 @@ static void nonmovingPrepareMark(void) #endif } -// Mark weak pointers in the non-moving heap. They'll either end up in -// dead_weak_ptr_list or stay in weak_ptr_list. Either way they need to be kept -// during sweep. See `MarkWeak.c:markWeakPtrList` for the moving heap variant -// of this. -static void nonmovingMarkWeakPtrList(MarkQueue *mark_queue, StgWeak *dead_weak_ptr_list) -{ - for (StgWeak *w = oldest_gen->weak_ptr_list; w; w = w->link) { - markQueuePushClosureGC(mark_queue, (StgClosure*)w); - // Do not mark finalizers and values here, those fields will be marked - // in `nonmovingMarkDeadWeaks` (for dead weaks) or - // `nonmovingTidyWeaks` (for live weaks) - } - - // We need to mark dead_weak_ptr_list too. This is subtle: - // - // - By the beginning of this GC we evacuated all weaks to the non-moving - // heap (in `markWeakPtrList`) - // - // - During the scavenging of the moving heap we discovered that some of - // those weaks are dead and moved them to `dead_weak_ptr_list`. Note that - // because of the fact above _all weaks_ are in the non-moving heap at - // this point. - // - // - So, to be able to traverse `dead_weak_ptr_list` and run finalizers we - // need to mark it. - for (StgWeak *w = dead_weak_ptr_list; w; w = w->link) { - markQueuePushClosureGC(mark_queue, (StgClosure*)w); - - // Mark the value and finalizer since they will be needed regardless of - // whether we find the weak is live. - if (w->cfinalizers != &stg_NO_FINALIZER_closure) { - markQueuePushClosureGC(mark_queue, w->value); - } - markQueuePushClosureGC(mark_queue, w->finalizer); - } -} - -void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) +void nonmovingCollect(StgWeak **dead_weaks STG_UNUSED, StgTSO **resurrected_threads) { #if defined(THREADED_RTS) // We can't start a new collection until the old one has finished @@ -945,6 +914,7 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) ASSERT(n_nonmoving_marked_compact_blocks == 0); MarkQueue *mark_queue = stgMallocBytes(sizeof(MarkQueue), "mark queue"); + mark_queue->blocks = NULL; initMarkQueue(mark_queue); current_mark_queue = mark_queue; @@ -956,9 +926,16 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) capabilities[n], true/*don't mark sparks*/); } markScheduler((evac_fn)markQueueAddRoot, mark_queue); - nonmovingMarkWeakPtrList(mark_queue, *dead_weaks); markStablePtrTable((evac_fn)markQueueAddRoot, mark_queue); + // The dead weak pointer list shouldn't contain any weaks in the + // nonmoving heap +#if defined(DEBUG) + for (StgWeak *w = *dead_weaks; w; w = w->link) { + ASSERT(Bdescr((StgPtr) w)->gen != oldest_gen); + } +#endif + // Mark threads resurrected during moving heap scavenging for (StgTSO *tso = *resurrected_threads; tso != END_TSO_QUEUE; tso = tso->global_link) { markQueuePushClosureGC(mark_queue, (StgClosure*)tso); @@ -984,8 +961,23 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) // alive). ASSERT(oldest_gen->old_weak_ptr_list == NULL); ASSERT(nonmoving_old_weak_ptr_list == NULL); - nonmoving_old_weak_ptr_list = oldest_gen->weak_ptr_list; - oldest_gen->weak_ptr_list = NULL; + { + // Move both oldest_gen->weak_ptr_list and nonmoving_weak_ptr_list to + // nonmoving_old_weak_ptr_list + StgWeak **weaks = &oldest_gen->weak_ptr_list; + uint32_t n = 0; + while (*weaks) { + weaks = &(*weaks)->link; + n++; + } + debugTrace(DEBUG_nonmoving_gc, "%d new nonmoving weaks", n); + *weaks = nonmoving_weak_ptr_list; + nonmoving_old_weak_ptr_list = oldest_gen->weak_ptr_list; + nonmoving_weak_ptr_list = NULL; + oldest_gen->weak_ptr_list = NULL; + // At this point all weaks in the nonmoving generation are on + // nonmoving_old_weak_ptr_list + } trace(TRACE_nonmoving_gc, "Finished nonmoving GC preparation"); // We are now safe to start concurrent marking @@ -1021,19 +1013,25 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) } /* Mark queue, threads, and weak pointers until no more weaks have been - * resuscitated + * resuscitated. If *budget is non-zero then we will mark no more than + * Returns true if we there is no more marking work to be done, false if + * we exceeded our marking budget. */ -static void nonmovingMarkThreadsWeaks(MarkQueue *mark_queue) +static bool nonmovingMarkThreadsWeaks(MarkBudget *budget, MarkQueue *mark_queue) { while (true) { // Propagate marks - nonmovingMark(mark_queue); + nonmovingMark(budget, mark_queue); + if (*budget == 0) { + return false; + } // Tidy threads and weaks nonmovingTidyThreads(); - if (! nonmovingTidyWeaks(mark_queue)) - return; + if (! nonmovingTidyWeaks(mark_queue)) { + return true; + } } } @@ -1047,7 +1045,6 @@ static void* nonmovingConcurrentMark(void *data) return NULL; } -// TODO: Not sure where to put this function. // Append w2 to the end of w1. static void appendWeakList( StgWeak **w1, StgWeak *w2 ) { @@ -1067,13 +1064,14 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * // Walk the list of filled segments that we collected during preparation, // updated their snapshot pointers and move them to the sweep list. for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { - struct NonmovingSegment *filled = nonmovingHeap.allocators[alloca_idx]->saved_filled; + struct NonmovingSegment *filled = nonmovingHeap.allocators[alloca_idx].saved_filled; uint32_t n_filled = 0; if (filled) { struct NonmovingSegment *seg = filled; while (true) { // Set snapshot nonmovingSegmentInfo(seg)->next_free_snap = seg->next_free; + SET_SEGMENT_STATE(seg, FILLED_SWEEPING); n_filled++; if (seg->link) { seg = seg->link; @@ -1082,14 +1080,24 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * } } // add filled segments to sweep_list - SET_SEGMENT_STATE(seg, FILLED_SWEEPING); seg->link = nonmovingHeap.sweep_list; nonmovingHeap.sweep_list = filled; } + nonmovingHeap.allocators[alloca_idx].saved_filled = NULL; } + // Mark Weak#s + nonmovingMarkWeakPtrList(mark_queue); + // Do concurrent marking; most of the heap will get marked here. - nonmovingMarkThreadsWeaks(mark_queue); + +#if defined(THREADED_RTS) +concurrent_marking: +#endif + { + MarkBudget budget = UNLIMITED_MARK_BUDGET; + nonmovingMarkThreadsWeaks(&budget, mark_queue); + } #if defined(THREADED_RTS) Task *task = newBoundTask(); @@ -1098,21 +1106,13 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * if (sched_state > SCHED_RUNNING) { // Note that we break our invariants here and leave segments in // nonmovingHeap.sweep_list, don't free nonmoving_large_objects etc. - // However because we won't be running mark-sweep in the final GC this + // However because we won't be running sweep in the final GC this // is OK. - - // This is a RTS shutdown so we need to move our copy (snapshot) of - // weaks (nonmoving_old_weak_ptr_list and nonmoving_weak_ptr_list) to - // oldest_gen->threads to be able to run C finalizers in hs_exit_. Note - // that there may be more weaks added to oldest_gen->threads since we - // started mark, so we need to append our list to the tail of - // oldest_gen->threads. - appendWeakList(&nonmoving_old_weak_ptr_list, nonmoving_weak_ptr_list); - appendWeakList(&oldest_gen->weak_ptr_list, nonmoving_old_weak_ptr_list); - // These lists won't be used again so this is not necessary, but still - nonmoving_old_weak_ptr_list = NULL; - nonmoving_weak_ptr_list = NULL; - + // + // However, we must move any weak pointers remaining on + // nonmoving_old_weak_ptr_list back to nonmoving_weak_ptr_list + // such that their C finalizers can be run by hs_exit_. + appendWeakList(&nonmoving_weak_ptr_list, nonmoving_old_weak_ptr_list); goto finish; } @@ -1120,9 +1120,17 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * nonmovingBeginFlush(task); bool all_caps_syncd; + MarkBudget sync_marking_budget = sync_phase_marking_budget; do { all_caps_syncd = nonmovingWaitForFlush(); - nonmovingMarkThreadsWeaks(mark_queue); + if (nonmovingMarkThreadsWeaks(&sync_marking_budget, mark_queue) == false) { + // We ran out of budget for marking. Abort sync. + // See Note [Sync phase marking budget]. + traceConcSyncEnd(); + stat_endNonmovingGcSync(); + releaseAllCapabilities(n_capabilities, NULL, task); + goto concurrent_marking; + } } while (!all_caps_syncd); #endif @@ -1133,7 +1141,7 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * // Do last marking of weak pointers while (true) { // Propagate marks - nonmovingMark(mark_queue); + nonmovingMarkUnlimitedBudget(mark_queue); if (!nonmovingTidyWeaks(mark_queue)) break; @@ -1142,7 +1150,7 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * nonmovingMarkDeadWeaks(mark_queue, dead_weaks); // Propagate marks - nonmovingMark(mark_queue); + nonmovingMarkUnlimitedBudget(mark_queue); // Now remove all dead objects from the mut_list to ensure that a younger // generation collection doesn't attempt to look at them after we've swept. @@ -1184,15 +1192,9 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * nonmoving_old_threads = END_TSO_QUEUE; } - { - StgWeak **weaks = &oldest_gen->weak_ptr_list; - while (*weaks) { - weaks = &(*weaks)->link; - } - *weaks = nonmoving_weak_ptr_list; - nonmoving_weak_ptr_list = NULL; - nonmoving_old_weak_ptr_list = NULL; - } + // At this point point any weak that remains on nonmoving_old_weak_ptr_list + // has a dead key. + nonmoving_old_weak_ptr_list = NULL; // Prune spark lists // See Note [Spark management under the nonmoving collector]. @@ -1290,10 +1292,12 @@ void assert_in_nonmoving_heap(StgPtr p) } for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { - struct NonmovingAllocator *alloca = nonmovingHeap.allocators[alloca_idx]; + struct NonmovingAllocator *alloca = &nonmovingHeap.allocators[alloca_idx]; + // Search current segments - for (uint32_t cap_idx = 0; cap_idx < getNumCapabilities(); ++cap_idx) { - struct NonmovingSegment *seg = alloca->current[cap_idx]; + for (uint32_t cap_idx = 0; cap_idx < nonmovingHeap.n_caps; ++cap_idx) { + Capability *cap = capabilities[cap_idx]; + struct NonmovingSegment *seg = cap->current_segments[alloca_idx]; if (p >= (P_)seg && p < (((P_)seg) + NONMOVING_SEGMENT_SIZE_W)) { return; } @@ -1352,33 +1356,16 @@ void nonmovingPrintSegment(struct NonmovingSegment *seg) debugBelch("End of segment\n\n"); } -void nonmovingPrintAllocator(struct NonmovingAllocator *alloc) -{ - debugBelch("Allocator at %p\n", (void*)alloc); - debugBelch("Filled segments:\n"); - for (struct NonmovingSegment *seg = alloc->filled; seg != NULL; seg = seg->link) { - debugBelch("%p ", (void*)seg); - } - debugBelch("\nActive segments:\n"); - for (struct NonmovingSegment *seg = alloc->active; seg != NULL; seg = seg->link) { - debugBelch("%p ", (void*)seg); - } - debugBelch("\nCurrent segments:\n"); - for (uint32_t i = 0; i < getNumCapabilities(); ++i) { - debugBelch("%p ", alloc->current[i]); - } - debugBelch("\n"); -} - void locate_object(P_ obj) { // Search allocators for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { - struct NonmovingAllocator *alloca = nonmovingHeap.allocators[alloca_idx]; - for (uint32_t cap = 0; cap < getNumCapabilities(); ++cap) { - struct NonmovingSegment *seg = alloca->current[cap]; + struct NonmovingAllocator *alloca = &nonmovingHeap.allocators[alloca_idx]; + for (uint32_t cap_n = 0; cap_n < nonmovingHeap.n_caps; ++cap_n) { + Capability *cap = capabilities[cap_n]; + struct NonmovingSegment *seg = cap->current_segments[alloca_idx]; if (obj >= (P_)seg && obj < (((P_)seg) + NONMOVING_SEGMENT_SIZE_W)) { - debugBelch("%p is in current segment of capability %d of allocator %d at %p\n", obj, cap, alloca_idx, (void*)seg); + debugBelch("%p is in current segment of capability %d of allocator %d at %p\n", obj, cap_n, alloca_idx, (void*)seg); return; } } ===================================== rts/sm/NonMoving.h ===================================== @@ -84,8 +84,7 @@ struct NonmovingAllocator { struct NonmovingSegment *filled; struct NonmovingSegment *saved_filled; struct NonmovingSegment *active; - // indexed by capability number - struct NonmovingSegment *current[]; + // N.B. Per-capabilty "current" segment lives in Capability }; // first allocator is of size 2^NONMOVING_ALLOCA0 (in bytes) @@ -99,7 +98,7 @@ struct NonmovingAllocator { #define NONMOVING_MAX_FREE 16 struct NonmovingHeap { - struct NonmovingAllocator *allocators[NONMOVING_ALLOCA_CNT]; + struct NonmovingAllocator allocators[NONMOVING_ALLOCA_CNT]; // free segment list. This is a cache where we keep up to // NONMOVING_MAX_FREE segments to avoid thrashing the block allocator. // Note that segments in this list are still counted towards @@ -149,7 +148,7 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads); void *nonmovingAllocate(Capability *cap, StgWord sz); -void nonmovingAddCapabilities(uint32_t new_n_caps); +void nonmovingInitCapability(Capability *cap); void nonmovingPushFreeSegment(struct NonmovingSegment *seg); void nonmovingClearBitmap(struct NonmovingSegment *seg); @@ -166,7 +165,7 @@ INLINE_HEADER uint8_t nonmovingSegmentLogBlockSize(struct NonmovingSegment *seg) INLINE_HEADER void nonmovingPushActiveSegment(struct NonmovingSegment *seg) { struct NonmovingAllocator *alloc = - nonmovingHeap.allocators[nonmovingSegmentLogBlockSize(seg) - NONMOVING_ALLOCA0]; + &nonmovingHeap.allocators[nonmovingSegmentLogBlockSize(seg) - NONMOVING_ALLOCA0]; SET_SEGMENT_STATE(seg, ACTIVE); while (true) { struct NonmovingSegment *current_active = (struct NonmovingSegment*)VOLATILE_LOAD(&alloc->active); @@ -181,7 +180,7 @@ INLINE_HEADER void nonmovingPushActiveSegment(struct NonmovingSegment *seg) INLINE_HEADER void nonmovingPushFilledSegment(struct NonmovingSegment *seg) { struct NonmovingAllocator *alloc = - nonmovingHeap.allocators[nonmovingSegmentLogBlockSize(seg) - NONMOVING_ALLOCA0]; + &nonmovingHeap.allocators[nonmovingSegmentLogBlockSize(seg) - NONMOVING_ALLOCA0]; SET_SEGMENT_STATE(seg, FILLED); while (true) { struct NonmovingSegment *current_filled = (struct NonmovingSegment*)VOLATILE_LOAD(&alloc->filled); @@ -289,20 +288,17 @@ INLINE_HEADER void nonmovingSetClosureMark(StgPtr p) nonmovingSetMark(nonmovingGetSegment(p), nonmovingGetBlockIdx(p)); } -// TODO: Audit the uses of these -/* Was the given closure marked this major GC cycle? */ -INLINE_HEADER bool nonmovingClosureMarkedThisCycle(StgPtr p) +INLINE_HEADER uint8_t nonmovingGetClosureMark(StgPtr p) { struct NonmovingSegment *seg = nonmovingGetSegment(p); nonmoving_block_idx blk_idx = nonmovingGetBlockIdx(p); - return nonmovingGetMark(seg, blk_idx) == nonmovingMarkEpoch; + return nonmovingGetMark(seg, blk_idx); } -INLINE_HEADER bool nonmovingClosureMarked(StgPtr p) +/* Was the given closure marked this major GC cycle? */ +INLINE_HEADER bool nonmovingClosureMarkedThisCycle(StgPtr p) { - struct NonmovingSegment *seg = nonmovingGetSegment(p); - nonmoving_block_idx blk_idx = nonmovingGetBlockIdx(p); - return nonmovingGetMark(seg, blk_idx) != 0; + return nonmovingGetClosureMark(p) == nonmovingMarkEpoch; } // Can be called during a major collection to determine whether a particular @@ -336,10 +332,14 @@ INLINE_HEADER bool nonmovingClosureBeingSwept(StgClosure *p) } } +// N.B. RtsFlags is defined as a pointer in STG code consequently this code +// doesn't typecheck. +#if !IN_STG_CODE INLINE_HEADER bool isNonmovingClosure(StgClosure *p) { - return !HEAP_ALLOCED_GC(p) || Bdescr((P_)p)->flags & BF_NONMOVING; + return RtsFlags.GcFlags.useNonmoving && (!HEAP_ALLOCED_GC(p) || Bdescr((P_)p)->flags & BF_NONMOVING); } +#endif #if defined(DEBUG) ===================================== rts/sm/NonMovingCensus.c ===================================== @@ -21,10 +21,12 @@ // stopped. In this case is safe to look at active and current segments so we can // also collect statistics on live words. static struct NonmovingAllocCensus -nonmovingAllocatorCensus_(struct NonmovingAllocator *alloc, bool collect_live_words) +nonmovingAllocatorCensus_(uint32_t alloc_idx, bool collect_live_words) { struct NonmovingAllocCensus census = {collect_live_words, 0, 0, 0, 0}; + struct NonmovingAllocator *alloc = &nonmovingHeap.allocators[alloc_idx]; + // filled segments for (struct NonmovingSegment *seg = alloc->filled; seg != NULL; seg = seg->link) @@ -40,6 +42,7 @@ nonmovingAllocatorCensus_(struct NonmovingAllocator *alloc, bool collect_live_wo } } + // active segments for (struct NonmovingSegment *seg = alloc->active; seg != NULL; seg = seg->link) @@ -56,9 +59,11 @@ nonmovingAllocatorCensus_(struct NonmovingAllocator *alloc, bool collect_live_wo } } - for (unsigned int cap=0; cap < getNumCapabilities(); cap++) + // current segments + for (unsigned int cap_n=0; cap_n < getNumCapabilities(); cap_n++) { - struct NonmovingSegment *seg = alloc->current[cap]; + Capability *cap = capabilities[cap_n]; + struct NonmovingSegment *seg = cap->current_segments[alloc_idx]; unsigned int n = nonmovingSegmentBlockCount(seg); for (unsigned int i=0; i < n; i++) { if (nonmovingGetMark(seg, i)) { @@ -76,15 +81,15 @@ nonmovingAllocatorCensus_(struct NonmovingAllocator *alloc, bool collect_live_wo * all blocks in nonmoving heap are valid closures. */ struct NonmovingAllocCensus -nonmovingAllocatorCensusWithWords(struct NonmovingAllocator *alloc) +nonmovingAllocatorCensusWithWords(uint32_t alloc_idx) { - return nonmovingAllocatorCensus_(alloc, true); + return nonmovingAllocatorCensus_(alloc_idx, true); } struct NonmovingAllocCensus -nonmovingAllocatorCensus(struct NonmovingAllocator *alloc) +nonmovingAllocatorCensus(uint32_t alloc_idx) { - return nonmovingAllocatorCensus_(alloc, false); + return nonmovingAllocatorCensus_(alloc_idx, false); } @@ -130,7 +135,7 @@ void nonmovingPrintAllocatorCensus(bool collect_live_words) for (int i=0; i < NONMOVING_ALLOCA_CNT; i++) { struct NonmovingAllocCensus census = - nonmovingAllocatorCensus_(nonmovingHeap.allocators[i], collect_live_words); + nonmovingAllocatorCensus_(i, collect_live_words); print_alloc_census(i, census); } @@ -143,8 +148,7 @@ void nonmovingTraceAllocatorCensus() return; for (int i=0; i < NONMOVING_ALLOCA_CNT; i++) { - const struct NonmovingAllocCensus census = - nonmovingAllocatorCensus(nonmovingHeap.allocators[i]); + const struct NonmovingAllocCensus census = nonmovingAllocatorCensus(i); const uint32_t log_blk_size = i + NONMOVING_ALLOCA0; traceNonmovingHeapCensus(log_blk_size, &census); } ===================================== rts/sm/NonMovingCensus.h ===================================== @@ -20,10 +20,10 @@ struct NonmovingAllocCensus { struct NonmovingAllocCensus -nonmovingAllocatorCensusWithWords(struct NonmovingAllocator *alloc); +nonmovingAllocatorCensusWithWords(uint32_t alloc_idx); struct NonmovingAllocCensus -nonmovingAllocatorCensus(struct NonmovingAllocator *alloc); +nonmovingAllocatorCensus(uint32_t alloc_idx); void nonmovingPrintAllocatorCensus(bool collect_live_words); void nonmovingTraceAllocatorCensus(void); ===================================== rts/sm/NonMovingMark.c ===================================== @@ -39,6 +39,9 @@ static void trace_PAP_payload (MarkQueue *queue, StgClosure *fun, StgClosure **payload, StgWord size); +#if defined(DEBUG) +static bool is_nonmoving_weak(StgWeak *weak); +#endif // How many Array# entries to add to the mark queue at once? #define MARK_ARRAY_CHUNK_LENGTH 128 @@ -254,7 +257,7 @@ StgWord nonmoving_write_barrier_enabled = false; MarkQueue *current_mark_queue = NULL; /* Initialise update remembered set data structures */ -void nonmovingMarkInitUpdRemSet() { +void nonmovingMarkInit() { #if defined(THREADED_RTS) initMutex(&upd_rem_set_lock); initCondition(&upd_rem_set_flushed_cond); @@ -274,6 +277,7 @@ static void nonmovingAddUpdRemSetBlocks_(MarkQueue *rset) bdescr *end = start; while (end->link != NULL) end = end->link; + rset->blocks = NULL; // add the blocks to the global remembered set ACQUIRE_LOCK(&upd_rem_set_lock); @@ -297,8 +301,8 @@ static void nonmovingAddUpdRemSetBlocks_lock(MarkQueue *rset) // Reset the state of the remembered set. ACQUIRE_SM_LOCK; init_mark_queue_(rset); - rset->is_upd_rem_set = true; RELEASE_SM_LOCK; + rset->is_upd_rem_set = true; } /* @@ -651,6 +655,16 @@ void updateRemembSetPushThunkEager(Capability *cap, } break; } + case THUNK_SELECTOR: + { + StgSelector *sel = (StgSelector *) thunk; + if (check_in_nonmoving_heap(sel->selectee)) { + // Don't bother to push origin; it makes the barrier needlessly + // expensive with little benefit. + push_closure(queue, sel->selectee, NULL); + } + break; + } case AP: { StgAP *ap = (StgAP *) thunk; @@ -660,9 +674,11 @@ void updateRemembSetPushThunkEager(Capability *cap, trace_PAP_payload(queue, ap->fun, ap->payload, ap->n_args); break; } - case THUNK_SELECTOR: + // We may end up here if a thunk update races with another update. + // In this case there is nothing to do as the other thread will have + // already pushed the updated thunk's free variables to the update + // remembered set. case BLACKHOLE: - // TODO: This is right, right? break; // The selector optimization performed by the nonmoving mark may have // overwritten a thunk which we are updating with an indirection. @@ -909,6 +925,7 @@ static MarkQueueEnt markQueuePop (MarkQueue *q) static void init_mark_queue_ (MarkQueue *queue) { bdescr *bd = allocGroup(MARK_QUEUE_BLOCKS); + ASSERT(queue->blocks == NULL); queue->blocks = bd; queue->top = (MarkQueueBlock *) bd->start; queue->top->head = 0; @@ -1293,8 +1310,11 @@ mark_closure (MarkQueue *queue, const StgClosure *p0, StgClosure **origin) goto done; case WHITEHOLE: - while (*(StgInfoTable* volatile*) &p->header.info == &stg_WHITEHOLE_info); - // busy_wait_nop(); // FIXME + while (*(StgInfoTable* volatile*) &p->header.info == &stg_WHITEHOLE_info) +#if defined(PARALLEL_GC) + busy_wait_nop() +#endif + ; goto try_again; default: @@ -1502,10 +1522,12 @@ mark_closure (MarkQueue *queue, const StgClosure *p0, StgClosure **origin) break; } + case WEAK: + ASSERT(is_nonmoving_weak((StgWeak*) p)); + // fallthrough gen_obj: case CONSTR: case CONSTR_NOCAF: - case WEAK: case PRIM: { for (StgWord i = 0; i < info->layout.payload.ptrs; i++) { @@ -1558,8 +1580,15 @@ mark_closure (MarkQueue *queue, const StgClosure *p0, StgClosure **origin) } case THUNK_SELECTOR: - nonmoving_eval_thunk_selector(queue, (StgSelector*)p, origin); + { + StgSelector *sel = (StgSelector *) p; + // We may be able to evaluate this selector which may render the + // selectee unreachable. However, we must mark the selectee regardless + // to satisfy the snapshot invariant. + PUSH_FIELD(sel, selectee); + nonmoving_eval_thunk_selector(queue, sel, origin); break; + } case AP_STACK: { StgAP_STACK *ap = (StgAP_STACK *)p; @@ -1709,15 +1738,23 @@ done: * b. the nursery has been fully evacuated into the non-moving generation. * c. the mark queue has been seeded with a set of roots. * + * If budget is not UNLIMITED_MARK_BUDGET, then we will mark no more than the + * indicated number of objects and deduct the work done from the budget. */ GNUC_ATTR_HOT void -nonmovingMark (MarkQueue *queue) +nonmovingMark (MarkBudget* budget, MarkQueue *queue) { traceConcMarkBegin(); debugTrace(DEBUG_nonmoving_gc, "Starting mark pass"); - unsigned int count = 0; + uint64_t count = 0; while (true) { count++; + if (*budget == 0) { + return; + } else if (*budget != UNLIMITED_MARK_BUDGET) { + *budget -= 1; + } + MarkQueueEnt ent = markQueuePop(queue); switch (nonmovingMarkQueueEntryType(&ent)) { @@ -1846,20 +1883,66 @@ static bool nonmovingIsNowAlive (StgClosure *p) bdescr *bd = Bdescr((P_)p); - // All non-static objects in the non-moving heap should be marked as - // BF_NONMOVING - ASSERT(bd->flags & BF_NONMOVING); + const uint16_t flags = bd->flags; + if (flags & BF_LARGE) { + if (flags & BF_PINNED && !(flags & BF_NONMOVING)) { + // In this case we have a pinned object living in a non-full + // accumulator block which was not promoted to the nonmoving + // generation. Assume that the object is alive. + // See #22014. + return true; + } - if (bd->flags & BF_LARGE) { + ASSERT(bd->flags & BF_NONMOVING); return (bd->flags & BF_NONMOVING_SWEEPING) == 0 // the large object wasn't in the snapshot and therefore wasn't marked || (bd->flags & BF_MARKED) != 0; // The object was marked } else { - return nonmovingClosureMarkedThisCycle((P_)p); + // All non-static objects in the non-moving heap should be marked as + // BF_NONMOVING. + ASSERT(bd->flags & BF_NONMOVING); + + struct NonmovingSegment *seg = nonmovingGetSegment((StgPtr) p); + StgClosure *snapshot_loc = + (StgClosure *) nonmovingSegmentGetBlock(seg, nonmovingSegmentInfo(seg)->next_free_snap); + if (p >= snapshot_loc && nonmovingGetClosureMark((StgPtr) p) == 0) { + /* + * In this case we are looking at a block that wasn't allocated + * at the time that the snapshot was taken. As we do not mark such + * blocks, we must assume that it is reachable. + */ + return true; + } else { + return nonmovingClosureMarkedThisCycle((P_)p); + } + } +} + +// Mark all Weak#s on nonmoving_old_weak_ptr_list. +void nonmovingMarkWeakPtrList (struct MarkQueue_ *queue) +{ + ASSERT(nonmoving_weak_ptr_list == NULL); + for (StgWeak *w = nonmoving_old_weak_ptr_list; w != NULL; w = w->link) { + mark_closure(queue, (StgClosure *) w, NULL); } } +// Determine whether a weak pointer object is on one of the nonmoving +// collector's weak pointer lists. Used for sanity checking. +#if defined(DEBUG) +static bool is_nonmoving_weak(StgWeak *weak) +{ + for (StgWeak *w = nonmoving_old_weak_ptr_list; w != NULL; w = w->link) { + if (w == weak) return true; + } + for (StgWeak *w = nonmoving_weak_ptr_list; w != NULL; w = w->link) { + if (w == weak) return true; + } + return false; +} +#endif + // Non-moving heap variant of `tidyWeakList` bool nonmovingTidyWeaks (struct MarkQueue_ *queue) { @@ -1868,6 +1951,9 @@ bool nonmovingTidyWeaks (struct MarkQueue_ *queue) StgWeak **last_w = &nonmoving_old_weak_ptr_list; StgWeak *next_w; for (StgWeak *w = nonmoving_old_weak_ptr_list; w != NULL; w = next_w) { + // This should have been marked by nonmovingMarkWeaks + ASSERT(nonmovingIsNowAlive((StgClosure *) w)); + if (w->header.info == &stg_DEAD_WEAK_info) { // finalizeWeak# was called on the weak next_w = w->link; @@ -1878,7 +1964,10 @@ bool nonmovingTidyWeaks (struct MarkQueue_ *queue) // Otherwise it's a live weak ASSERT(w->header.info == &stg_WEAK_info); - if (nonmovingIsNowAlive(w->key)) { + // See Note [Weak pointer processing and the non-moving GC] in + // MarkWeak.c + bool key_in_nonmoving = Bdescr((StgPtr) w->key)->flags & BF_NONMOVING; + if (!key_in_nonmoving || nonmovingIsNowAlive(w->key)) { nonmovingMarkLiveWeak(queue, w); did_work = true; @@ -1886,7 +1975,7 @@ bool nonmovingTidyWeaks (struct MarkQueue_ *queue) *last_w = w->link; next_w = w->link; - // and put it on the weak ptr list + // and put it on nonmoving_weak_ptr_list w->link = nonmoving_weak_ptr_list; nonmoving_weak_ptr_list = w; } else { @@ -1908,7 +1997,8 @@ void nonmovingMarkDeadWeak (struct MarkQueue_ *queue, StgWeak *w) void nonmovingMarkLiveWeak (struct MarkQueue_ *queue, StgWeak *w) { - ASSERT(nonmovingClosureMarkedThisCycle((P_)w)); + ASSERT(nonmovingIsNowAlive((StgClosure *) w)); + ASSERT(nonmovingIsNowAlive((StgClosure *) w->key)); markQueuePushClosure_(queue, w->value); markQueuePushClosure_(queue, w->finalizer); markQueuePushClosure_(queue, w->cfinalizers); @@ -1922,9 +2012,9 @@ void nonmovingMarkDeadWeaks (struct MarkQueue_ *queue, StgWeak **dead_weaks) { StgWeak *next_w; for (StgWeak *w = nonmoving_old_weak_ptr_list; w; w = next_w) { - ASSERT(!nonmovingClosureMarkedThisCycle((P_)(w->key))); + ASSERT(!nonmovingIsNowAlive(w->key)); nonmovingMarkDeadWeak(queue, w); - next_w = w ->link; + next_w = w->link; w->link = *dead_weaks; *dead_weaks = w; } ===================================== rts/sm/NonMovingMark.h ===================================== @@ -111,6 +111,11 @@ typedef struct { MarkQueue queue; } UpdRemSet; +// How much marking work we are allowed to perform +// See Note [Sync phase marking budget] in NonMoving.c +typedef int64_t MarkBudget; +#define UNLIMITED_MARK_BUDGET INT64_MIN + // Number of blocks to allocate for a mark queue #define MARK_QUEUE_BLOCKS 16 @@ -135,7 +140,7 @@ extern MarkQueue *current_mark_queue; extern bdescr *upd_rem_set_block_list; -void nonmovingMarkInitUpdRemSet(void); +void nonmovingMarkInit(void); void nonmovingInitUpdRemSet(UpdRemSet *rset); void updateRemembSetPushClosure(Capability *cap, StgClosure *p); @@ -154,8 +159,13 @@ void markQueueAddRoot(MarkQueue* q, StgClosure** root); void initMarkQueue(MarkQueue *queue); void freeMarkQueue(MarkQueue *queue); -void nonmovingMark(struct MarkQueue_ *restrict queue); +void nonmovingMark(MarkBudget *budget, struct MarkQueue_ *restrict queue); +INLINE_HEADER void nonmovingMarkUnlimitedBudget(struct MarkQueue_ *restrict queue) { + MarkBudget budget = UNLIMITED_MARK_BUDGET; + nonmovingMark(&budget, queue); +} +void nonmovingMarkWeakPtrList(struct MarkQueue_ *queue); bool nonmovingTidyWeaks(struct MarkQueue_ *queue); void nonmovingTidyThreads(void); void nonmovingMarkDeadWeaks(struct MarkQueue_ *queue, StgWeak **dead_weak_ptr_list); ===================================== rts/sm/Sanity.c ===================================== @@ -619,11 +619,12 @@ static void checkNonmovingSegments (struct NonmovingSegment *seg) void checkNonmovingHeap (const struct NonmovingHeap *heap) { for (unsigned int i=0; i < NONMOVING_ALLOCA_CNT; i++) { - const struct NonmovingAllocator *alloc = heap->allocators[i]; + const struct NonmovingAllocator *alloc = &heap->allocators[i]; checkNonmovingSegments(alloc->filled); checkNonmovingSegments(alloc->active); - for (unsigned int cap=0; cap < getNumCapabilities(); cap++) { - checkNonmovingSegments(alloc->current[cap]); + for (unsigned int cap_n=0; cap_n < getNumCapabilities(); cap_n++) { + Capability *cap = capabilities[cap_n]; + checkNonmovingSegments(cap->current_segments[i]); } } } @@ -1047,11 +1048,12 @@ findMemoryLeak (void) markBlocks(nonmoving_compact_objects); markBlocks(nonmoving_marked_compact_objects); for (i = 0; i < NONMOVING_ALLOCA_CNT; i++) { - struct NonmovingAllocator *alloc = nonmovingHeap.allocators[i]; + struct NonmovingAllocator *alloc = &nonmovingHeap.allocators[i]; markNonMovingSegments(alloc->filled); markNonMovingSegments(alloc->active); for (j = 0; j < getNumCapabilities(); j++) { - markNonMovingSegments(alloc->current[j]); + Capability *cap = capabilities[j]; + markNonMovingSegments(cap->current_segments[i]); } } markNonMovingSegments(nonmovingHeap.sweep_list); @@ -1156,23 +1158,18 @@ countNonMovingSegments(struct NonmovingSegment *segs) return ret; } -static W_ -countNonMovingAllocator(struct NonmovingAllocator *alloc) -{ - W_ ret = countNonMovingSegments(alloc->filled) - + countNonMovingSegments(alloc->active); - for (uint32_t i = 0; i < getNumCapabilities(); ++i) { - ret += countNonMovingSegments(alloc->current[i]); - } - return ret; -} - static W_ countNonMovingHeap(struct NonmovingHeap *heap) { W_ ret = 0; for (int alloc_idx = 0; alloc_idx < NONMOVING_ALLOCA_CNT; alloc_idx++) { - ret += countNonMovingAllocator(heap->allocators[alloc_idx]); + struct NonmovingAllocator *alloc = &heap->allocators[alloc_idx]; + ret += countNonMovingSegments(alloc->filled); + ret += countNonMovingSegments(alloc->active); + for (uint32_t c = 0; c < getNumCapabilities(); ++c) { + Capability *cap = capabilities[c]; + ret += countNonMovingSegments(cap->current_segments[alloc_idx]); + } } ret += countNonMovingSegments(heap->sweep_list); ret += countNonMovingSegments(heap->free); ===================================== rts/sm/Storage.c ===================================== @@ -214,17 +214,14 @@ initStorage (void) } oldest_gen->to = oldest_gen; - // Nonmoving heap uses oldest_gen so initialize it after initializing oldest_gen - nonmovingInit(); - #if defined(THREADED_RTS) // nonmovingAddCapabilities allocates segments, which requires taking the gc // sync lock, so initialize it before nonmovingAddCapabilities initSpinLock(&gc_alloc_block_sync); #endif - if (RtsFlags.GcFlags.useNonmoving) - nonmovingAddCapabilities(getNumCapabilities()); + // Nonmoving heap uses oldest_gen so initialize it after initializing oldest_gen + nonmovingInit(); /* The oldest generation has one step. */ if (RtsFlags.GcFlags.compact || RtsFlags.GcFlags.sweep) { @@ -320,11 +317,10 @@ void storageAddCapabilities (uint32_t from, uint32_t to) } } - // Initialize NonmovingAllocators and UpdRemSets + // Initialize non-moving collector if (RtsFlags.GcFlags.useNonmoving) { - nonmovingAddCapabilities(to); - for (i = 0; i < to; ++i) { - nonmovingInitUpdRemSet(&capabilities[i]->upd_rem_set); + for (i = from; i < to; i++) { + nonmovingInitCapability(capabilities[i]); } } ===================================== testsuite/tests/rts/all.T ===================================== @@ -339,7 +339,7 @@ test('T10904', [ omit_ways(['ghci']), extra_run_opts('20000') ], test('T10728', [extra_run_opts('+RTS -maxN3 -RTS'), only_ways(['threaded2'])], compile_and_run, ['']) -test('T9405', [when(msys(), expect_broken(12714))], makefile_test, ['T9405']) +test('T9405', [], makefile_test, ['T9405']) test('T11788', when(ghc_dynamic(), skip), makefile_test, ['T11788']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/87c547c7bec75094127d7b73e2fc45650ba98ae2...06a4a65fff9268589270e99762d5d18a64cabc6c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/87c547c7bec75094127d7b73e2fc45650ba98ae2...06a4a65fff9268589270e99762d5d18a64cabc6c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 13:48:14 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 08 Feb 2023 08:48:14 -0500 Subject: [Git][ghc/ghc][wip/rts-warnings] 98 commits: Detect family instance orphans correctly Message-ID: <63e3a81eb26a1_730ce526201659e5@gitlab.mail> Ben Gamari pushed to branch wip/rts-warnings at Glasgow Haskell Compiler / GHC Commits: 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - fd1263c2 by Ben Gamari at 2023-02-08T08:48:08-05:00 rts/ipe: Fix unused lock warning - - - - - 9c6cf72d by Ben Gamari at 2023-02-08T08:48:08-05:00 rts/ProfilerReportJson: Fix memory leak - - - - - 0c7e07cb by Ben Gamari at 2023-02-08T08:48:08-05:00 rts: Various warnings fixes - - - - - fc4ec538 by Ben Gamari at 2023-02-08T08:48:08-05:00 rts: Fix printf format mismatch - - - - - 52e233be by Ben Gamari at 2023-02-08T08:48:08-05:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - 87ded94a by Ben Gamari at 2023-02-08T08:48:08-05:00 nonmoving: Fix unused definition warrnings - - - - - 68f96688 by Ben Gamari at 2023-02-08T08:48:08-05:00 hadrian: Ensure that -Werror is passed to C compilations Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. - - - - - ef6fb936 by Ben Gamari at 2023-02-08T08:48:08-05:00 Disable futimens on Darwin. See #22938 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - cabal.project-reinstall - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Reg.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/BlockLayout.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/984c88e500ce50003902a149eb801f454a1be5a9...ef6fb93654a424edc943076163f2e6d279f19dd9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/984c88e500ce50003902a149eb801f454a1be5a9...ef6fb93654a424edc943076163f2e6d279f19dd9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 14:30:40 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 08 Feb 2023 09:30:40 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: JS: avoid head/tail and unpackFS Message-ID: <63e3b210ce779_730ce44cba7c177085@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 0c3d1028 by sheaf at 2023-02-08T09:30:25-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 22085bcd by Matthew Pickering at 2023-02-08T09:30:25-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 17 changed files: - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/StgToJS/Printer.hs - testsuite/driver/runtests.py - testsuite/driver/testlib.py - + testsuite/tests/rename/should_compile/T22913.hs - testsuite/tests/rename/should_compile/all.T - − testsuite/tests/simplCore/should_compile/T21148.hs - − testsuite/tests/simplCore/should_compile/T21148.stderr - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/stranal/should_compile/T21128.hs - testsuite/tests/stranal/should_compile/T21128.stderr Changes: ===================================== compiler/GHC/Core/Opt/Exitify.hs ===================================== @@ -433,7 +433,6 @@ inlining. Exit join points, recognizable using `isExitJoinId` are join points with an occurrence in a recursive group, and can be recognized (after the occurrence analyzer ran!) using `isExitJoinId`. - This function detects joinpoints with `occ_in_lam (idOccinfo id) == True`, because the lambdas of a non-recursive join point are not considered for `occ_in_lam`. For example, in the following code, `j1` is /not/ marked @@ -447,29 +446,6 @@ To prevent inlining, we check for isExitJoinId * In `simplLetUnfolding` we simply give exit join points no unfolding, which prevents inlining in `postInlineUnconditionally` and call sites. -But see Note [Be selective about not-inlining exit join points] - -Note [Be selective about not-inlining exit join points] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If we follow "do not inline exit join points" mantra throughout, -some bad things happen. - -* We can lose CPR information: see #21148 - -* We get useless clutter (#22084) that - - makes the program bigger (including duplicated code #20739), and - - adds extra jumps (and maybe stack saves) at runtime - -So instead we follow "do not inline exit join points" for a /single run/ -of the simplifier, right after Exitification. That should give a -sufficient chance for used-once things to inline, but subsequent runs -will inline them back in. (Annoyingly, as things stand, only with -O2 -is there a subsequent run, but that might change, and it's not a huge -deal anyway.) - -This is controlled by the Simplifier's sm_keep_exits flag; see -GHC.Core.Opt.Pipeline. - Note [Placement of the exitification pass] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ I (Joachim) experimented with multiple positions for the Exitification pass in ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -15,7 +15,7 @@ import GHC.Driver.Plugins ( withPlugins, installCoreToDos ) import GHC.Driver.Env import GHC.Driver.Config.Core.Lint ( endPass ) import GHC.Driver.Config.Core.Opt.LiberateCase ( initLiberateCaseOpts ) -import GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyOpts, initSimplMode ) +import GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyOpts, initSimplMode, initGentleSimplMode ) import GHC.Driver.Config.Core.Opt.WorkWrap ( initWorkWrapOpts ) import GHC.Driver.Config.Core.Rules ( initRuleOpts ) import GHC.Platform.Ways ( hasWay, Way(WayProf) ) @@ -28,7 +28,6 @@ import GHC.Core.Utils ( dumpIdInfoOfProgram ) import GHC.Core.Lint ( lintAnnots ) import GHC.Core.Lint.Interactive ( interactiveInScope ) import GHC.Core.Opt.Simplify ( simplifyExpr, simplifyPgm ) -import GHC.Core.Opt.Simplify.Env( SimplMode(..) ) import GHC.Core.Opt.Simplify.Monad import GHC.Core.Opt.Monad import GHC.Core.Opt.Pipeline.Types @@ -153,45 +152,32 @@ getCoreToDo dflags hpt_rule_base extra_vars maybe_strictness_before _ = CoreDoNothing - ---------------------------- - base_simpl_mode :: SimplMode - base_simpl_mode = initSimplMode dflags - - -- gentle_mode: make specialiser happy: minimum effort please - -- See Note [Inline in InitialPhase] - -- See Note [RULEs enabled in InitialPhase] - gentle_mode = base_simpl_mode { sm_names = ["Gentle"] - , sm_phase = InitialPhase - , sm_case_case = False } - - simpl_mode phase name - = base_simpl_mode { sm_names = [name], sm_phase = phase } - - keep_exits :: SimplMode -> SimplMode - -- See Note [Be selective about not-inlining exit join points] - -- in GHC.Core.Opt.Exitify - keep_exits mode = mode { sm_keep_exits = True } - - ---------------------------- - run_simplifier mode iter - = CoreDoSimplify $ initSimplifyOpts dflags extra_vars iter mode hpt_rule_base - - simpl_phase phase name iter = CoreDoPasses $ - [ maybe_strictness_before phase - , run_simplifier (simpl_mode phase name) iter - , maybe_rule_check phase ] + simpl_phase phase name iter + = CoreDoPasses + $ [ maybe_strictness_before phase + , CoreDoSimplify $ initSimplifyOpts dflags extra_vars iter + (initSimplMode dflags phase name) hpt_rule_base + , maybe_rule_check phase ] -- Run GHC's internal simplification phase, after all rules have run. -- See Note [Compiler phases] in GHC.Types.Basic - simpl_gently = run_simplifier gentle_mode max_iter - simplify_final name = run_simplifier ( simpl_mode FinalPhase name) max_iter - simpl_keep_exits name = run_simplifier (keep_exits $ simpl_mode FinalPhase name) max_iter + simplify name = simpl_phase FinalPhase name max_iter + + -- initial simplify: mk specialiser happy: minimum effort please + -- See Note [Inline in InitialPhase] + -- See Note [RULEs enabled in InitialPhase] + simpl_gently = CoreDoSimplify $ initSimplifyOpts dflags extra_vars max_iter + (initGentleSimplMode dflags) hpt_rule_base - ---------------------------- dmd_cpr_ww = if ww_on then [CoreDoDemand True,CoreDoCpr,CoreDoWorkerWrapper] else [CoreDoDemand False] -- NB: No CPR! See Note [Don't change boxity without worker/wrapper] + demand_analyser = (CoreDoPasses ( + dmd_cpr_ww ++ + [simplify "post-worker-wrapper"] + )) + -- Static forms are moved to the top level with the FloatOut pass. -- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable. static_ptrs_float_outwards = @@ -281,16 +267,14 @@ getCoreToDo dflags hpt_rule_base extra_vars runWhen call_arity $ CoreDoPasses [ CoreDoCallArity - , simplify_final "post-call-arity" + , simplify "post-call-arity" ], -- Strictness analysis - runWhen strictness $ CoreDoPasses - (dmd_cpr_ww ++ [simplify_final "post-worker-wrapper"]), + runWhen strictness demand_analyser, runWhen exitification CoreDoExitify, -- See Note [Placement of the exitification pass] - -- in GHC.Core.Opt.Exitify runWhen full_laziness $ CoreDoFloatOutwards FloatOutSwitches { @@ -312,17 +296,7 @@ getCoreToDo dflags hpt_rule_base extra_vars runWhen do_float_in CoreDoFloatInwards, - -- Final tidy-up run of the simplifier - simpl_keep_exits "final tidy up", - -- Keep exit join point because this is the first - -- Simplifier run after Exitify. Subsequent runs will - -- re-inline those exit join points; their work is done. - -- See Note [Be selective about not-inlining exit join points] - -- in GHC.Core.Opt.Exitify - -- - -- Annoyingly, we only /have/ a subsequent run with -O2. With - -- plain -O we'll still have those exit join points hanging around. - -- Oh well. + simplify "final", -- Final tidy-up maybe_rule_check FinalPhase, @@ -332,31 +306,31 @@ getCoreToDo dflags hpt_rule_base extra_vars -- Case-liberation for -O2. This should be after -- strictness analysis and the simplification which follows it. runWhen liberate_case $ CoreDoPasses - [ CoreLiberateCase, simplify_final "post-liberate-case" ], + [ CoreLiberateCase, simplify "post-liberate-case" ], -- Run the simplifier after LiberateCase to vastly -- reduce the possibility of shadowing -- Reason: see Note [Shadowing] in GHC.Core.Opt.SpecConstr runWhen spec_constr $ CoreDoPasses - [ CoreDoSpecConstr, simplify_final "post-spec-constr"], + [ CoreDoSpecConstr, simplify "post-spec-constr"], -- See Note [Simplify after SpecConstr] maybe_rule_check FinalPhase, runWhen late_specialise $ CoreDoPasses - [ CoreDoSpecialising, simplify_final "post-late-spec"], + [ CoreDoSpecialising, simplify "post-late-spec"], -- LiberateCase can yield new CSE opportunities because it peels -- off one layer of a recursive function (concretely, I saw this -- in wheel-sieve1), and I'm guessing that SpecConstr can too -- And CSE is a very cheap pass. So it seems worth doing here. runWhen ((liberate_case || spec_constr) && cse) $ CoreDoPasses - [ CoreCSE, simplify_final "post-final-cse" ], + [ CoreCSE, simplify "post-final-cse" ], --------- End of -O2 passes -------------- runWhen late_dmd_anal $ CoreDoPasses ( - dmd_cpr_ww ++ [simplify_final "post-late-ww"] + dmd_cpr_ww ++ [simplify "post-late-ww"] ), -- Final run of the demand_analyser, ensures that one-shot thunks are ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -248,16 +248,13 @@ data SimplMode = SimplMode -- See comments in GHC.Core.Opt.Simplify.Monad , sm_uf_opts :: !UnfoldingOpts -- ^ Unfolding options , sm_case_case :: !Bool -- ^ Whether case-of-case is enabled , sm_pre_inline :: !Bool -- ^ Whether pre-inlining is enabled - , sm_keep_exits :: !Bool -- ^ True <=> keep ExitJoinIds - -- See Note [Do not inline exit join points] - -- in GHC.Core.Opt.Exitify - , sm_float_enable :: !FloatEnable -- ^ Whether to enable floating out + , sm_float_enable :: !FloatEnable -- ^ Whether to enable floating out , sm_do_eta_reduction :: !Bool - , sm_arity_opts :: !ArityOpts - , sm_rule_opts :: !RuleOpts - , sm_case_folding :: !Bool - , sm_case_merge :: !Bool - , sm_co_opt_opts :: !OptCoercionOpts -- ^ Coercion optimiser options + , sm_arity_opts :: !ArityOpts + , sm_rule_opts :: !RuleOpts + , sm_case_folding :: !Bool + , sm_case_merge :: !Bool + , sm_co_opt_opts :: !OptCoercionOpts -- ^ Coercion optimiser options } instance Outputable SimplMode where ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1395,11 +1395,11 @@ preInlineUnconditionally -- Reason: we don't want to inline single uses, or discard dead bindings, -- for unlifted, side-effect-ful bindings preInlineUnconditionally env top_lvl bndr rhs rhs_env - | not pre_inline = Nothing + | not pre_inline_unconditionally = Nothing | not active = Nothing | isTopLevel top_lvl && isDeadEndId bndr = Nothing -- Note [Top-level bottoming Ids] | isCoVar bndr = Nothing -- Note [Do not inline CoVars unconditionally] - | keep_exits, isExitJoinId bndr = Nothing -- Note [Do not inline exit join points] + | isExitJoinId bndr = Nothing -- Note [Do not inline exit join points] -- in module Exitify | not (one_occ (idOccInfo bndr)) = Nothing | not (isStableUnfolding unf) = Just $! (extend_subst_with rhs) @@ -1409,36 +1409,19 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env , Just inl <- maybeUnfoldingTemplate unf = Just $! (extend_subst_with inl) | otherwise = Nothing where - mode = seMode env - phase = sm_phase mode - keep_exits = sm_keep_exits mode - pre_inline = sm_pre_inline mode - unf = idUnfolding bndr extend_subst_with inl_rhs = extendIdSubst env bndr $! (mkContEx rhs_env inl_rhs) one_occ IAmDead = True -- Happens in ((\x.1) v) - one_occ OneOcc{ occ_n_br = 1 , occ_in_lam = NotInsideLam } = isNotTopLevel top_lvl || early_phase - one_occ OneOcc{ occ_n_br = 1 , occ_in_lam = IsInsideLam , occ_int_cxt = IsInteresting } = canInlineInLam rhs + one_occ _ = False - one_occ OneOcc{ occ_n_br = 1 } -- Inline join point that are used once, even inside - | isJoinId bndr = True -- lambdas (which are presumably other join points) - -- E.g. join j x = rhs in - -- joinrec k y = ....j x.... - -- Here j must be an exit for k, and we can safely inline it under the lambda - -- This includes the case where j is nullary: a nullary join point is just the - -- same as an arity-1 one. So we don't look at occ_int_cxt. - -- All of this only applies if keep_exits is False, otherwise the - -- earlier guard on preInlineUnconditionally would have fired - - one_occ _ = False - - active = isActive phase (inlinePragmaActivation inline_prag) + pre_inline_unconditionally = sePreInline env + active = isActive (sePhase env) (inlinePragmaActivation inline_prag) -- See Note [pre/postInlineUnconditionally in gentle mode] inline_prag = idInlinePragma bndr @@ -1470,7 +1453,7 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env -- not ticks. Counting ticks cannot be duplicated, and non-counting -- ticks around a Lam will disappear anyway. - early_phase = phase /= FinalPhase + early_phase = sePhase env /= FinalPhase -- If we don't have this early_phase test, consider -- x = length [1,2,3] -- The full laziness pass carefully floats all the cons cells to ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -1532,10 +1532,8 @@ scExpr' env (Case scrut b ty alts) scrut_occ = case con of DataAlt dc -- See Note [Do not specialise evals] | not (single_alt && all deadArgOcc arg_occs) - -> -- pprTrace "sc_alt1" (ppr b' $$ ppr con $$ ppr bs $$ ppr arg_occs) $ - ScrutOcc (unitUFM dc arg_occs) - _ -> -- pprTrace "sc_alt1" (ppr b' $$ ppr con $$ ppr bs $$ ppr arg_occs) $ - UnkOcc + -> ScrutOcc (unitUFM dc arg_occs) + _ -> UnkOcc ; return (usg', b_occ `combineOcc` scrut_occ, Alt con bs2 rhs') } ===================================== compiler/GHC/Driver/Config/Core/Opt/Simplify.hs ===================================== @@ -2,6 +2,7 @@ module GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyExprOpts , initSimplifyOpts , initSimplMode + , initGentleSimplMode ) where import GHC.Prelude @@ -26,13 +27,12 @@ import GHC.Types.Var ( Var ) initSimplifyExprOpts :: DynFlags -> InteractiveContext -> SimplifyExprOpts initSimplifyExprOpts dflags ic = SimplifyExprOpts { se_fam_inst = snd $ ic_instances ic - - , se_mode = (initSimplMode dflags) { sm_names = ["GHCi"] - , sm_inline = False } - -- sm_inline: do not do any inlining, in case we expose - -- some unboxed tuple stuff that confuses the bytecode + , se_mode = (initSimplMode dflags InitialPhase "GHCi") + { sm_inline = False + -- Do not do any inlining, in case we expose some + -- unboxed tuple stuff that confuses the bytecode -- interpreter - + } , se_top_env_cfg = TopEnvConfig { te_history_size = historySize dflags , te_tick_factor = simplTickFactor dflags @@ -56,25 +56,31 @@ initSimplifyOpts dflags extra_vars iterations mode hpt_rule_base = let } in opts -initSimplMode :: DynFlags -> SimplMode -initSimplMode dflags = SimplMode - { sm_names = ["Unknown simplifier run"] -- Always overriden - , sm_phase = InitialPhase - , sm_rules = gopt Opt_EnableRewriteRules dflags - , sm_eta_expand = gopt Opt_DoLambdaEtaExpansion dflags - , sm_pre_inline = gopt Opt_SimplPreInlining dflags - , sm_do_eta_reduction = gopt Opt_DoEtaReduction dflags - , sm_uf_opts = unfoldingOpts dflags - , sm_float_enable = floatEnable dflags - , sm_arity_opts = initArityOpts dflags - , sm_rule_opts = initRuleOpts dflags - , sm_case_folding = gopt Opt_CaseFolding dflags - , sm_case_merge = gopt Opt_CaseMerge dflags - , sm_co_opt_opts = initOptCoercionOpts dflags +initSimplMode :: DynFlags -> CompilerPhase -> String -> SimplMode +initSimplMode dflags phase name = SimplMode + { sm_names = [name] + , sm_phase = phase + , sm_rules = gopt Opt_EnableRewriteRules dflags + , sm_eta_expand = gopt Opt_DoLambdaEtaExpansion dflags , sm_cast_swizzle = True - , sm_inline = True - , sm_case_case = True - , sm_keep_exits = False + , sm_inline = True + , sm_uf_opts = unfoldingOpts dflags + , sm_case_case = True + , sm_pre_inline = gopt Opt_SimplPreInlining dflags + , sm_float_enable = floatEnable dflags + , sm_do_eta_reduction = gopt Opt_DoEtaReduction dflags + , sm_arity_opts = initArityOpts dflags + , sm_rule_opts = initRuleOpts dflags + , sm_case_folding = gopt Opt_CaseFolding dflags + , sm_case_merge = gopt Opt_CaseMerge dflags + , sm_co_opt_opts = initOptCoercionOpts dflags + } + +initGentleSimplMode :: DynFlags -> SimplMode +initGentleSimplMode dflags = (initSimplMode dflags InitialPhase "Gentle") + { -- Don't do case-of-case transformations. + -- This makes full laziness work better + sm_case_case = False } floatEnable :: DynFlags -> FloatEnable ===================================== compiler/GHC/Rename/Bind.hs ===================================== @@ -893,17 +893,15 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs -- Rename the pragmas and signatures -- Annoyingly the type variables /are/ in scope for signatures, but - -- /are not/ in scope in the SPECIALISE instance pramas; e.g. - -- instance Eq a => Eq (T a) where - -- (==) :: a -> a -> a - -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-} - ; let (spec_inst_prags, other_sigs) = partition isSpecInstLSig sigs + -- /are not/ in scope in SPECIALISE and SPECIALISE instance pragmas. + -- See Note [Type variable scoping in SPECIALISE pragmas]. + ; let (spec_prags, other_sigs) = partition (isSpecLSig <||> isSpecInstLSig) sigs bound_nms = mkNameSet (collectHsBindsBinders CollNoDictBinders binds') sig_ctxt | is_cls_decl = ClsDeclCtxt cls | otherwise = InstDeclCtxt bound_nms - ; (spec_inst_prags', sip_fvs) <- renameSigs sig_ctxt spec_inst_prags - ; (other_sigs', sig_fvs) <- bindLocalNamesFV ktv_names $ - renameSigs sig_ctxt other_sigs + ; (spec_prags', spg_fvs) <- renameSigs sig_ctxt spec_prags + ; (other_sigs', sig_fvs) <- bindLocalNamesFV ktv_names $ + renameSigs sig_ctxt other_sigs -- Rename the bindings RHSs. Again there's an issue about whether the -- type variables from the class/instance head are in scope. @@ -914,8 +912,47 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs emptyFVs binds_w_dus ; return (mapBag fstOf3 binds_w_dus, bind_fvs) } - ; return ( binds'', spec_inst_prags' ++ other_sigs' - , sig_fvs `plusFV` sip_fvs `plusFV` bind_fvs) } + ; return ( binds'', spec_prags' ++ other_sigs' + , sig_fvs `plusFV` spg_fvs `plusFV` bind_fvs) } + +{- Note [Type variable scoping in SPECIALISE pragmas] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When renaming the methods of a class or instance declaration, we must be careful +with the scoping of the type variables that occur in SPECIALISE and SPECIALISE instance +pragmas: the type variables from the class/instance header DO NOT scope over these, +unlike class/instance method type signatures. + +Examples: + + 1. SPECIALISE + + class C a where + meth :: a + instance C (Maybe a) where + meth = Nothing + {-# SPECIALISE INLINE meth :: Maybe [a] #-} + + 2. SPECIALISE instance + + instance Eq a => Eq (T a) where + (==) :: a -> a -> a + {-# SPECIALISE instance Eq a => Eq (T [a]) #-} + + In both cases, the type variable `a` mentioned in the PRAGMA is NOT the same + as the type variable `a` from the instance header. + For example, the SPECIALISE instance pragma above is a shorthand for + + {-# SPECIALISE instance forall a. Eq a => Eq (T [a]) #-} + + which is alpha-equivalent to + + {-# SPECIALISE instance forall b. Eq b => Eq (T [b]) #-} + + This shows that the type variables are not bound in the header. + + Getting this scoping wrong can lead to out-of-scope type variable errors from + Core Lint, see e.g. #22913. +-} rnMethodBindLHS :: Bool -> Name -> LHsBindLR GhcPs GhcPs ===================================== compiler/GHC/StgToJS/Printer.hs ===================================== @@ -108,19 +108,17 @@ ghcjsRenderJsV r (JHash m) where quoteIfRequired :: FastString -> Doc quoteIfRequired x - | isUnquotedKey x' = text x' - | otherwise = PP.squotes (text x') - where x' = unpackFS x - - isUnquotedKey :: String -> Bool - isUnquotedKey x | null x = False - | all isDigit x = True - | otherwise = validFirstIdent (head x) - && all validOtherIdent (tail x) + | isUnquotedKey x = ftext x + | otherwise = PP.squotes (ftext x) + isUnquotedKey :: FastString -> Bool + isUnquotedKey fs = case unpackFS fs of + [] -> False + s@(c:cs) -> all isDigit s || (validFirstIdent c && all validOtherIdent cs) validFirstIdent c = c == '_' || c == '$' || isAlpha c validOtherIdent c = isAlpha c || isDigit c + ghcjsRenderJsV r v = renderJsV defaultRenderJs r v prettyBlock :: RenderJs -> [JStat] -> Doc ===================================== testsuite/driver/runtests.py ===================================== @@ -601,6 +601,7 @@ else: if args.junit: junit(t).write(args.junit) + args.junit.close() if config.only_report_hadrian_deps: print("WARNING - skipping all tests and only reporting required hadrian dependencies:", config.hadrian_deps) ===================================== testsuite/driver/testlib.py ===================================== @@ -1347,7 +1347,7 @@ def do_test(name: TestName, # if found and instead have the testsuite decide on what to do # with the output. def override_options(pre_cmd): - if config.verbose >= 5 and bool(re.match('\$make', pre_cmd, re.I)): + if config.verbose >= 5 and bool(re.match(r'\$make', pre_cmd, re.I)): return pre_cmd.replace(' -s' , '') \ .replace('--silent', '') \ .replace('--quiet' , '') @@ -1989,7 +1989,7 @@ def split_file(in_fn: Path, delimiter: str, out1_fn: Path, out2_fn: Path): with out1_fn.open('w', encoding='utf8', newline='') as out1: with out2_fn.open('w', encoding='utf8', newline='') as out2: line = infile.readline() - while re.sub('^\s*','',line) != delimiter and line != '': + while re.sub(r'^\s*','',line) != delimiter and line != '': out1.write(line) line = infile.readline() @@ -2399,20 +2399,20 @@ def normalise_errmsg(s: str) -> str: # warning message to get clean output. if config.msys: s = re.sub('Failed to remove file (.*); error= (.*)$', '', s) - s = re.sub('DeleteFile "(.+)": permission denied \(Access is denied\.\)(.*)$', '', s) + s = re.sub(r'DeleteFile "(.+)": permission denied \(Access is denied\.\)(.*)$', '', s) # filter out unsupported GNU_PROPERTY_TYPE (5), which is emitted by LLVM10 # and not understood by older binutils (ar, ranlib, ...) - s = modify_lines(s, lambda l: re.sub('^(.+)warning: (.+): unsupported GNU_PROPERTY_TYPE \(5\) type: 0xc000000(.*)$', '', l)) + s = modify_lines(s, lambda l: re.sub(r'^(.+)warning: (.+): unsupported GNU_PROPERTY_TYPE \(5\) type: 0xc000000(.*)$', '', l)) - s = re.sub('ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) + s = re.sub(r'ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) s = re.sub('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version','',s) # ignore superfluous dylibs passed to the linker. s = re.sub('ld: warning: .*, ignoring unexpected dylib file\n','',s) # ignore LLVM Version mismatch garbage; this will just break tests. s = re.sub('You are using an unsupported version of LLVM!.*\n','',s) - s = re.sub('Currently only [\.0-9]+ is supported. System LLVM version: [\.0-9]+.*\n','',s) - s = re.sub('We will try though\.\.\..*\n','',s) + s = re.sub('Currently only [\\.0-9]+ is supported. System LLVM version: [\\.0-9]+.*\n','',s) + s = re.sub('We will try though\\.\\.\\..*\n','',s) # ignore warning about strip invalidating signatures s = re.sub('.*strip: changes being made to the file will invalidate the code signature in.*\n','',s) # clang may warn about unused argument when used as assembler @@ -2475,8 +2475,8 @@ def normalise_slashes_( s: str ) -> str: return s def normalise_exe_( s: str ) -> str: - s = re.sub('\.exe', '', s) - s = re.sub('\.jsexe', '', s) + s = re.sub(r'\.exe', '', s) + s = re.sub(r'\.jsexe', '', s) return s def normalise_output( s: str ) -> str: @@ -2494,14 +2494,14 @@ def normalise_output( s: str ) -> str: # ghci outputs are pretty unstable with -fexternal-dynamic-refs, which is # requires for -fPIC s = re.sub(' -fexternal-dynamic-refs\n','',s) - s = re.sub('ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) + s = re.sub(r'ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) s = re.sub('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version','',s) # ignore superfluous dylibs passed to the linker. s = re.sub('ld: warning: .*, ignoring unexpected dylib file\n','',s) # ignore LLVM Version mismatch garbage; this will just break tests. s = re.sub('You are using an unsupported version of LLVM!.*\n','',s) - s = re.sub('Currently only [\.0-9]+ is supported. System LLVM version: [\.0-9]+.*\n','',s) - s = re.sub('We will try though\.\.\..*\n','',s) + s = re.sub('Currently only [\\.0-9]+ is supported. System LLVM version: [\\.0-9]+.*\n','',s) + s = re.sub('We will try though\\.\\.\\..*\n','',s) # ignore warning about strip invalidating signatures s = re.sub('.*strip: changes being made to the file will invalidate the code signature in.*\n','',s) # clang may warn about unused argument when used as assembler ===================================== testsuite/tests/rename/should_compile/T22913.hs ===================================== @@ -0,0 +1,10 @@ +module T22913 where + +class FromSourceIO a where + fromSourceIO :: a +instance FromSourceIO (Maybe o) where + fromSourceIO = undefined + {-# SPECIALISE INLINE fromSourceIO :: Maybe o #-} + -- This SPECIALISE pragma caused a Core Lint error + -- due to incorrectly scoping the type variable 'o' from the instance header + -- over the SPECIALISE pragma. ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -199,3 +199,4 @@ test('T22513f', normal, compile, ['-Wterm-variable-capture']) test('T22513g', normal, compile, ['-Wterm-variable-capture']) test('T22513h', normal, compile, ['-Wterm-variable-capture']) test('T22513i', req_th, compile, ['-Wterm-variable-capture']) +test('T22913', normal, compile, ['']) ===================================== testsuite/tests/simplCore/should_compile/T21148.hs deleted ===================================== @@ -1,12 +0,0 @@ -module T211148 where - --- The point of this test is that f should get a (nested) --- CPR property, with a worker of type --- $wf :: Int# -> State# RealWorld -> (# State# RealWorld, Int# #) - -{-# NOINLINE f #-} --- The NOINLINE makes GHC do a worker/wrapper split --- even though f is small -f :: Int -> IO Int -f x = return $! sum [0..x] - ===================================== testsuite/tests/simplCore/should_compile/T21148.stderr deleted ===================================== @@ -1,126 +0,0 @@ - -==================== Tidy Core ==================== -Result size of Tidy Core - = {terms: 73, types: 80, coercions: 6, joins: 2/2} - --- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule4 :: GHC.Prim.Addr# -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] -T211148.$trModule4 = "main"# - --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule3 :: GHC.Types.TrName -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -T211148.$trModule3 = GHC.Types.TrNameS T211148.$trModule4 - --- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule2 :: GHC.Prim.Addr# -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] -T211148.$trModule2 = "T211148"# - --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule1 :: GHC.Types.TrName -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -T211148.$trModule1 = GHC.Types.TrNameS T211148.$trModule2 - --- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule :: GHC.Types.Module -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -T211148.$trModule - = GHC.Types.Module T211148.$trModule3 T211148.$trModule1 - --- RHS size: {terms: 41, types: 35, coercions: 0, joins: 2/2} -T211148.$wf [InlPrag=NOINLINE] - :: GHC.Prim.Int# - -> GHC.Prim.State# GHC.Prim.RealWorld - -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #) -[GblId, Arity=2, Str=, Unf=OtherCon []] -T211148.$wf - = \ (ww_s179 :: GHC.Prim.Int#) - (eta_s17b [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld) -> - case GHC.Prim.># 0# ww_s179 of { - __DEFAULT -> - join { - exit_X0 [Dmd=SC(S,C(1,!P(L,L)))] - :: GHC.Prim.Int# - -> GHC.Prim.Int# - -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #) - [LclId[JoinId(2)(Nothing)], Arity=2, Str=] - exit_X0 (x_s16Z [OS=OneShot] :: GHC.Prim.Int#) - (ww1_s172 [OS=OneShot] :: GHC.Prim.Int#) - = (# eta_s17b, GHC.Prim.+# ww1_s172 x_s16Z #) } in - joinrec { - $wgo3_s175 [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,C(1,!P(L,L)))] - :: GHC.Prim.Int# - -> GHC.Prim.Int# - -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #) - [LclId[JoinId(2)(Nothing)], Arity=2, Str=, Unf=OtherCon []] - $wgo3_s175 (x_s16Z :: GHC.Prim.Int#) (ww1_s172 :: GHC.Prim.Int#) - = case GHC.Prim.==# x_s16Z ww_s179 of { - __DEFAULT -> - jump $wgo3_s175 - (GHC.Prim.+# x_s16Z 1#) (GHC.Prim.+# ww1_s172 x_s16Z); - 1# -> jump exit_X0 x_s16Z ww1_s172 - }; } in - jump $wgo3_s175 0# 0#; - 1# -> (# eta_s17b, 0# #) - } - --- RHS size: {terms: 14, types: 19, coercions: 0, joins: 0/0} -T211148.f1 [InlPrag=NOINLINE[final]] - :: Int - -> GHC.Prim.State# GHC.Prim.RealWorld - -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #) -[GblId, - Arity=2, - Str=<1!P(L)>, - Cpr=1(, 1), - Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (x_s177 [Occ=Once1!] :: Int) - (eta_s17b [Occ=Once1, OS=OneShot] - :: GHC.Prim.State# GHC.Prim.RealWorld) -> - case x_s177 of { GHC.Types.I# ww_s179 [Occ=Once1] -> - case T211148.$wf ww_s179 eta_s17b of - { (# ww1_s17e [Occ=Once1], ww2_s17j [Occ=Once1] #) -> - (# ww1_s17e, GHC.Types.I# ww2_s17j #) - } - }}] -T211148.f1 - = \ (x_s177 :: Int) - (eta_s17b [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld) -> - case x_s177 of { GHC.Types.I# ww_s179 -> - case T211148.$wf ww_s179 eta_s17b of { (# ww1_s17e, ww2_s17j #) -> - (# ww1_s17e, GHC.Types.I# ww2_s17j #) - } - } - --- RHS size: {terms: 1, types: 0, coercions: 6, joins: 0/0} -f [InlPrag=NOINLINE[final]] :: Int -> IO Int -[GblId, - Arity=2, - Str=<1!P(L)>, - Cpr=1(, 1), - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}] -f = T211148.f1 - `cast` (_R %<'Many>_N ->_R Sym (GHC.Types.N:IO[0] _R) - :: (Int - -> GHC.Prim.State# GHC.Prim.RealWorld - -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)) - ~R# (Int -> IO Int)) - - - ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -429,7 +429,6 @@ test('T21763a', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) test('T22028', normal, compile, ['-O -ddump-rule-firings']) test('T22114', normal, compile, ['-O']) test('T21286', normal, multimod_compile, ['T21286', '-O -ddump-rule-firings']) -test('T21148', [grep_errmsg(r'Cpr=') ], compile, ['-O -ddump-simpl']) # One module, T21851.hs, has OPTIONS_GHC -ddump-simpl test('T21851', [grep_errmsg(r'case.*w\$sf') ], multimod_compile, ['T21851', '-O -dno-typeable-binds -dsuppress-uniques']) ===================================== testsuite/tests/stranal/should_compile/T21128.hs ===================================== @@ -2,10 +2,6 @@ module T21128 where import T21128a -{- This test originally had some unnecessary reboxing of y -in the hot path of $wtheresCrud. That reboxing should -not happen. -} - theresCrud :: Int -> Int -> Int theresCrud x y = go x where @@ -13,4 +9,3 @@ theresCrud x y = go x go 1 = index x y 1 go n = go (n-1) {-# NOINLINE theresCrud #-} - ===================================== testsuite/tests/stranal/should_compile/T21128.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 125, types: 68, coercions: 4, joins: 0/0} + = {terms: 137, types: 92, coercions: 4, joins: 0/0} lvl = "error"# @@ -29,11 +29,17 @@ lvl9 = SrcLoc lvl2 lvl3 lvl5 lvl6 lvl7 lvl6 lvl8 lvl10 = PushCallStack lvl1 lvl9 EmptyCallStack +$windexError + = \ @a @b ww eta eta1 eta2 -> + error + (lvl10 `cast` :: CallStack ~R# (?callStack::CallStack)) + (++ (ww eta) (++ (ww eta1) (ww eta2))) + indexError = \ @a @b $dShow eta eta1 eta2 -> - error - (lvl10 `cast` :: ...) - (++ (show $dShow eta) (++ (show $dShow eta1) (show $dShow eta2))) + case $dShow of { C:Show ww ww1 ww2 -> + $windexError ww1 eta eta1 eta2 + } $trModule3 = TrNameS $trModule4 @@ -42,7 +48,8 @@ $trModule1 = TrNameS $trModule2 $trModule = Module $trModule3 $trModule1 $wlvl - = \ ww ww1 ww2 -> indexError $fShowInt (I# ww2) (I# ww1) (I# ww) + = \ ww ww1 ww2 -> + $windexError $fShowInt_$cshow (I# ww2) (I# ww1) (I# ww) index = \ l u i -> @@ -66,7 +73,7 @@ index ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 108, types: 46, coercions: 0, joins: 3/3} + = {terms: 108, types: 47, coercions: 0, joins: 3/4} $trModule4 = "main"# @@ -82,34 +89,35 @@ i = I# 1# l = I# 0# -lvl = \ x ww -> indexError $fShowInt x (I# ww) i +lvl = \ y -> $windexError $fShowInt_$cshow l y l -lvl1 = \ ww -> indexError $fShowInt l (I# ww) l +lvl1 = \ ww y -> $windexError $fShowInt_$cshow (I# ww) y i $wtheresCrud = \ ww ww1 -> + let { y = I# ww1 } in join { - exit - = case <# 0# ww1 of { - __DEFAULT -> case lvl1 ww1 of wild { }; - 1# -> 0# - } } in - join { - exit1 + lvl2 = case <=# ww 1# of { - __DEFAULT -> case lvl (I# ww) ww1 of wild { }; + __DEFAULT -> case lvl1 ww y of wild { }; 1# -> case <# 1# ww1 of { - __DEFAULT -> case lvl (I# ww) ww1 of wild { }; + __DEFAULT -> case lvl1 ww y of wild { }; 1# -> -# 1# ww } } } in + join { + lvl3 + = case <# 0# ww1 of { + __DEFAULT -> case lvl y of wild { }; + 1# -> 0# + } } in joinrec { $wgo ww2 = case ww2 of wild { __DEFAULT -> jump $wgo (-# wild 1#); - 0# -> jump exit; - 1# -> jump exit1 + 0# -> jump lvl3; + 1# -> jump lvl2 }; } in jump $wgo ww View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a933eab77971b711a652f9e681c9927173dff686...22085bcdf8b5ebf8e8a9b30fb74fbe400616c12c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a933eab77971b711a652f9e681c9927173dff686...22085bcdf8b5ebf8e8a9b30fb74fbe400616c12c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 15:59:34 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Wed, 08 Feb 2023 10:59:34 -0500 Subject: [Git][ghc/ghc][wip/t21766] Update user's guide and release notes Message-ID: <63e3c6e645e11_2b039a527603603a@gitlab.mail> Finley McIlwaine pushed to branch wip/t21766 at Glasgow Haskell Compiler / GHC Commits: 76f179c8 by Finley McIlwaine at 2023-02-08T08:58:52-07:00 Update user's guide and release notes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. See ticket #21766 - - - - - 4 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debug-info.rst Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -228,10 +228,6 @@ debug = vanilla { buildFlavour = SlowValidate , withAssertions = True -- WithNuma so at least one job tests Numa , withNuma = True - - -- Build with IPE in debug so at least one job tests - -- uncompressed IPE data - , withIpe = True } ipe :: BuildConfig @@ -878,7 +874,6 @@ job_groups = , validateBuilds Amd64 (Linux Debian10) nativeInt , fastCI (validateBuilds Amd64 (Linux Debian10) unreg) , fastCI (validateBuilds Amd64 (Linux Debian10) debug) - , disableValidate (validateBuilds Amd64 (Linux Debian10) ipe) , modifyValidateJobs manual tsan_jobs , modifyValidateJobs manual (validateBuilds Amd64 (Linux Debian10) noTntc) , addValidateRule LLVMBackend (validateBuilds Amd64 (Linux Debian10) llvm) ===================================== .gitlab/jobs.yaml ===================================== @@ -1031,7 +1031,7 @@ "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb10-numa-slow-validate+ipe": { + "nightly-x86_64-linux-deb10-numa-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -1041,7 +1041,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-deb10-numa-slow-validate+ipe.tar.xz", + "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", "junit.xml" ], "reports": { @@ -1083,11 +1083,11 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate+ipe", - "BUILD_FLAVOUR": "slow-validate+ipe", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate", + "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", - "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate+ipe", + "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate", "XZ_OPT": "-9" } }, @@ -3698,7 +3698,7 @@ "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate" } }, - "x86_64-linux-deb10-numa-slow-validate+ipe": { + "x86_64-linux-deb10-numa-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -3708,7 +3708,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb10-numa-slow-validate+ipe.tar.xz", + "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", "junit.xml" ], "reports": { @@ -3750,11 +3750,11 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate+ipe", - "BUILD_FLAVOUR": "slow-validate+ipe", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate", + "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", - "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate+ipe" + "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate" } }, "x86_64-linux-deb10-unreg-validate": { ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -21,6 +21,17 @@ Compiler foo (\x -> x*2 + x) +- The compiler may now be configured to compress the debugging information + included in :ghc-flag:`-finfo-table-map` enabled binaries. To do so, one must + build GHC from source (see + `here` for directions) + and supply the ``--enable-ipe-data-compression`` flag to the ``configure`` + script. **Note**: This feature requires that the machine building GHC has + `libzstd `_ installed. + + In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map` + enabled build results was reduced by over 20% when compression was enabled. + GHCi ~~~~ ===================================== docs/users_guide/debug-info.rst ===================================== @@ -370,9 +370,23 @@ to a source location. This lookup table is generated by using the ``-finfo-table also want more precise information about constructor info tables then you should also use :ghc-flag:`-fdistinct-constructor-tables`. - This flag will increase the binary size by quite a lot, depending on how - big your project is. For compiling a project the size of GHC the overhead was - about 200 megabytes. + The :ghc-flag:`-finfo-table-map` flag will increase the binary size by quite + a lot, depending on how big your project is. For compiling a project the + size of GHC the overhead was about 200 megabytes. + + :since: 9.8 + + If you wish to reduce the size of :ghc-flag:`-finfo-table-map` enabled + binaries, consider building GHC from source and supplying the + ``--enable-ipe-data-compression`` flag to the ``configure`` script. This + will cause GHC to compress the :ghc-flag:`-finfo-table-map` related + debugging information included in binaries using the `libzstd + `_ compression library. **Note**: This + feature requires that the machine building GHC has + `libzstd `_ installed. + + In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map` + enabled build results was reduced by over 20% when compression was enabled. .. ghc-flag:: -fdistinct-constructor-tables :shortdesc: Generate a fresh info table for each usage View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/76f179c87bec4465b3316c0c29ecdc80a204b826 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/76f179c87bec4465b3316c0c29ecdc80a204b826 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 16:00:35 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Wed, 08 Feb 2023 11:00:35 -0500 Subject: [Git][ghc/ghc][wip/t21766] 12 commits: JS: avoid head/tail and unpackFS Message-ID: <63e3c7236a0fe_2b039a8fa7a037098@gitlab.mail> Finley McIlwaine pushed to branch wip/t21766 at Glasgow Haskell Compiler / GHC Commits: c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - cc81f32e by Finley McIlwaine at 2023-02-08T09:00:04-07:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - d28eab3d by Finley McIlwaine at 2023-02-08T09:00:04-07:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - 008024e8 by Finley McIlwaine at 2023-02-08T09:00:04-07:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - 2158fbe5 by Finley McIlwaine at 2023-02-08T09:00:04-07:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - bcc45839 by Finley McIlwaine at 2023-02-08T09:00:04-07:00 Add note describing IPE data compression See ticket #21766 - - - - - cca0f881 by Finley McIlwaine at 2023-02-08T09:00:04-07:00 Fix byte order of IPE data, fix IPE tests Make sure byte order of written IPE buffer entries matches target. Make sure the IPE-related tests properly access the fields of IPE buffer entry nodes with the new IPE layout. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. See ticket #21766. - - - - - d8deebcf by Finley McIlwaine at 2023-02-08T09:00:04-07:00 Fix IPE data decompression buffer allocation Capacity of buffers allocated for decompressed IPE data was incorrect due to a misuse of the `ZSTD_findFrameCompressedSize` function. Fix by always storing decompressed size of IPE data in IPE buffer list nodes and using `ZSTD_findFrameCompressedSize` to determine the size of the compressed data. See ticket #21766 - - - - - 38a6dca8 by Finley McIlwaine at 2023-02-08T09:00:04-07:00 Add optional dependencies to ./configure output Changes the configure script to indicate whether libnuma, libzstd, or libdw are being used as dependencies due to their optional features being enabled. - - - - - 49b95513 by Finley McIlwaine at 2023-02-08T09:00:04-07:00 Add IPE-enabled builds to CI - Adds an IPE job to the CI pipeline which is triggered by the ~IPE label - Introduces CI logic to enable IPE data compression - Enables uncompressed IPE data on debug CI job - Regenerates jobs.yaml MR https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/112 on the images repository is meant to ensure that the proper images have libzstd-dev installed. - - - - - 2142c448 by Finley McIlwaine at 2023-02-08T09:00:04-07:00 Update user's guide and release notes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. See ticket #21766 - - - - - 25 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/StgToJS/Printer.hs - compiler/ghc.cabal.in - configure.ac - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debug-info.rst - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Packages.hs - m4/fp_find_libnuma.m4 - + m4/fp_find_libzstd.m4 - rts/IPE.c - rts/IPE.h - rts/include/rts/IPE.h - rts/rts.cabal.in - testsuite/driver/runtests.py - testsuite/driver/testlib.py - testsuite/tests/rts/ipe/ipeEventLog_fromMap.c - testsuite/tests/rts/ipe/ipeMap.c - testsuite/tests/rts/ipe/ipe_lib.c - testsuite/tests/rts/ipe/ipe_lib.h Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -140,6 +140,8 @@ data BuildConfig , llvmBootstrap :: Bool , withAssertions :: Bool , withNuma :: Bool + , withZstd :: Bool + , withIpe :: Bool , crossTarget :: Maybe String , crossEmulator :: CrossEmulator , configureWrapper :: Maybe String @@ -152,10 +154,11 @@ data BuildConfig -- Extra arguments to pass to ./configure due to the BuildConfig configureArgsStr :: BuildConfig -> String configureArgsStr bc = unwords $ - ["--enable-unregisterised"| unregisterised bc ] + ["--enable-unregisterised"| unregisterised bc ] ++ ["--disable-tables-next-to-code" | not (tablesNextToCode bc) ] ++ ["--with-intree-gmp" | Just _ <- pure (crossTarget bc) ] ++ ["--with-system-libffi" | crossTarget bc == Just "wasm32-wasi" ] + ++ ["--enable-ipe-data-compression" | withZstd bc ] -- Compute the hadrian flavour from the BuildConfig mkJobFlavour :: BuildConfig -> Flavour @@ -165,11 +168,18 @@ mkJobFlavour BuildConfig{..} = Flavour buildFlavour opts [Dwarf | withDwarf] ++ [FullyStatic | fullyStatic] ++ [ThreadSanitiser | threadSanitiser] ++ - [NoSplitSections | noSplitSections, buildFlavour == Release ] + [NoSplitSections | noSplitSections, buildFlavour == Release ] ++ + [Ipe | withIpe] data Flavour = Flavour BaseFlavour [FlavourTrans] -data FlavourTrans = Llvm | Dwarf | FullyStatic | ThreadSanitiser | NoSplitSections +data FlavourTrans = + Llvm + | Dwarf + | FullyStatic + | ThreadSanitiser + | NoSplitSections + | Ipe data BaseFlavour = Release | Validate | SlowValidate deriving Eq @@ -187,6 +197,8 @@ vanilla = BuildConfig , llvmBootstrap = False , withAssertions = False , withNuma = False + , withZstd = False + , withIpe = False , crossTarget = Nothing , crossEmulator = NoEmulator , configureWrapper = Nothing @@ -218,6 +230,11 @@ debug = vanilla { buildFlavour = SlowValidate , withNuma = True } +ipe :: BuildConfig +ipe = vanilla { withIpe = True + , withZstd = True + } + static :: BuildConfig static = vanilla { fullyStatic = True } @@ -306,17 +323,18 @@ testEnv arch opsys bc = intercalate "-" $ -- | The hadrian flavour string we are going to use for this build flavourString :: Flavour -> String -flavourString (Flavour base trans) = baseString base ++ concatMap (("+" ++) . flavourString) trans +flavourString (Flavour base trans) = base_string base ++ concatMap (("+" ++) . flavour_string) trans where - baseString Release = "release" - baseString Validate = "validate" - baseString SlowValidate = "slow-validate" + base_string Release = "release" + base_string Validate = "validate" + base_string SlowValidate = "slow-validate" - flavourString Llvm = "llvm" - flavourString Dwarf = "debug_info" - flavourString FullyStatic = "fully_static" - flavourString ThreadSanitiser = "thread_sanitizer" - flavourString NoSplitSections = "no_split_sections" + flavour_string Llvm = "llvm" + flavour_string Dwarf = "debug_info" + flavour_string FullyStatic = "fully_static" + flavour_string ThreadSanitiser = "thread_sanitizer" + flavour_string NoSplitSections = "no_split_sections" + flavour_string Ipe = "ipe" -- The path to the docker image (just for linux builders) dockerImage :: Arch -> Opsys -> Maybe String @@ -509,7 +527,7 @@ manualRule rules = rules { when = Manual } -- For example, even if you don't explicitly disable a rule it will end up in the -- rule list with the OFF state. enumRules :: OnOffRules -> [OnOffRule] -enumRules o = map lkup rules +enumRules o = map lkup rulesList where enabled_rules = rule_set o lkup r = OnOffRule (if S.member r enabled_rules then On else Off) r @@ -544,6 +562,7 @@ data Rule = FastCI -- ^ Run this job when the fast-ci label is set | Nightly -- ^ Only run this job in the nightly pipeline | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. + | IpeData -- ^ Only run this job when the "IPE" label is set | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) @@ -568,12 +587,14 @@ ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" ruleString Off Nightly = "$NIGHTLY == null" +ruleString On IpeData = "$CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/" +ruleString Off IpeData = true ruleString On Disable = false ruleString Off Disable = true -- Enumeration of all the rules -rules :: [Rule] -rules = [minBound .. maxBound] +rulesList :: [Rule] +rulesList = [minBound .. maxBound] -- | A 'Job' is the description of a single job in a gitlab pipeline. The -- job contains all the information about how to do the build but can be further @@ -856,7 +877,7 @@ job_groups = , modifyValidateJobs manual tsan_jobs , modifyValidateJobs manual (validateBuilds Amd64 (Linux Debian10) noTntc) , addValidateRule LLVMBackend (validateBuilds Amd64 (Linux Debian10) llvm) - + , addValidateRule IpeData (validateBuilds Amd64 (Linux Debian10) ipe) , disableValidate (standardBuilds Amd64 (Linux Debian11)) -- 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. ===================================== .gitlab/jobs.yaml ===================================== @@ -35,7 +35,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -97,7 +97,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -155,7 +155,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -213,7 +213,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -276,7 +276,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -335,7 +335,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -394,7 +394,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -453,7 +453,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -518,7 +518,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -579,7 +579,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -640,7 +640,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -701,7 +701,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -764,7 +764,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -825,7 +825,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -888,7 +888,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -948,7 +948,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1007,7 +1007,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1066,7 +1066,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1126,7 +1126,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1185,7 +1185,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1244,7 +1244,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1268,6 +1268,65 @@ "XZ_OPT": "-9" } }, + "nightly-x86_64-linux-deb10-validate+ipe": { + "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-deb10-validate+ipe.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb10-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$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-deb10-validate+ipe", + "BUILD_FLAVOUR": "validate+ipe", + "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "TEST_ENV": "x86_64-linux-deb10-validate+ipe", + "XZ_OPT": "-9" + } + }, "nightly-x86_64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -1303,7 +1362,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1362,7 +1421,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1423,7 +1482,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1484,7 +1543,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1546,7 +1605,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1605,7 +1664,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1664,7 +1723,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1725,7 +1784,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1787,7 +1846,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1848,7 +1907,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1908,7 +1967,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1967,7 +2026,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2022,7 +2081,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2081,7 +2140,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2144,7 +2203,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2208,7 +2267,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2268,7 +2327,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2328,7 +2387,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2394,7 +2453,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2458,7 +2517,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2522,7 +2581,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2583,7 +2642,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2643,7 +2702,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2703,7 +2762,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2763,7 +2822,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2823,7 +2882,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2885,7 +2944,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2947,7 +3006,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3010,7 +3069,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3071,7 +3130,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3131,7 +3190,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3187,7 +3246,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3247,7 +3306,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3311,7 +3370,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3375,7 +3434,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3435,7 +3494,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3495,7 +3554,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3557,7 +3616,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3616,7 +3675,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3674,7 +3733,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3733,7 +3792,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3791,7 +3850,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3814,6 +3873,64 @@ "TEST_ENV": "x86_64-linux-deb10-validate+debug_info" } }, + "x86_64-linux-deb10-validate+ipe": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "2 weeks", + "paths": [ + "ghc-x86_64-linux-deb10-validate+ipe.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb10-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$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\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"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-deb10-validate+ipe", + "BUILD_FLAVOUR": "validate+ipe", + "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "TEST_ENV": "x86_64-linux-deb10-validate+ipe" + } + }, "x86_64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -3849,7 +3966,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3908,7 +4025,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3968,7 +4085,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4028,7 +4145,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4089,7 +4206,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4145,7 +4262,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -1,66 +1,187 @@ +{-# LANGUAGE CPP #-} + module GHC.StgToCmm.InfoTableProv (emitIpeBufferListNode) where +import Foreign + +#if defined(HAVE_LIBZSTD) +import Foreign.C.Types +import qualified Data.ByteString.Internal as BSI +import GHC.IO (unsafePerformIO) +#endif + +import GHC.Data.FastString (fastStringToShortText) import GHC.Prelude import GHC.Platform +import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile) import GHC.Unit.Module import GHC.Utils.Outputable -import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile) -import GHC.Data.FastString (fastStringToShortText) +import GHC.Cmm import GHC.Cmm.CLabel -import GHC.Cmm.Expr import GHC.Cmm.Utils import GHC.StgToCmm.Config -import GHC.StgToCmm.Lit (newByteStringCLit) import GHC.StgToCmm.Monad -import GHC.StgToCmm.Utils import GHC.Data.ShortText (ShortText) import qualified GHC.Data.ShortText as ST -import qualified Data.Map.Strict as M import Control.Monad.Trans.State.Strict + import qualified Data.ByteString as BS import qualified Data.ByteString.Builder as BSB import qualified Data.ByteString.Lazy as BSL +import qualified Data.Map.Strict as M + +{- +Note [Compression and Decompression of IPE data] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Compiling with `-finfo-table-map` causes build results to include a map from +info tables to source positions called the info table provenance entry (IPE) +map. See Note [Mapping Info Tables to Source Positions]. The IPE information +can grow the size of build results significantly. At the time of writing, a +default build of GHC results in a total of 109M of libHSghc-*.so build results. +A default+ipe build of GHC (see ./hadrian/doc/flavours.md) results in 262M of +libHSghc-*.so build results without compression. -emitIpeBufferListNode :: Module - -> [InfoProvEnt] - -> FCode () +We reduce the impact of IPE data on the size of build results by compressing +the data before it is emitted using the zstd compression library. See +Note [The Info Table Provenance Entry (IPE) Map] for information on the layout +of IPE data on disk and in the RTS. We cannot simply compress all data held in +the IPE entry buffer, as the pointers to info tables must be converted to +memory addresses during linking. Therefore, we can only compress the strings +table and the IPE entries themselves (which essentially only consist of indices +into the strings table). + +With compression, a default+ipe build of GHC results in a total of 205M of +libHSghc-*.so build results. This is over a 20% reduction from the uncompressed +case. + +Decompression happens lazily, as it only occurs when the IPE map is +constructed (which is also done lazily on first lookup or traversal). During +construction, the 'compressed' field of each IPE buffer list node is examined. +If the field indicates that the data has been compressed, the entry data and +strings table are decompressed before continuing with the normal IPE map +construction. +-} + +emitIpeBufferListNode :: + Module + -> [InfoProvEnt] + -> FCode () emitIpeBufferListNode _ [] = return () emitIpeBufferListNode this_mod ents = do cfg <- getStgToCmmConfig - let ctx = stgToCmmContext cfg + + tables_lbl <- mkStringLitLabel <$> newUnique + strings_lbl <- mkStringLitLabel <$> newUnique + entries_lbl <- mkStringLitLabel <$> newUnique + + let ctx = stgToCmmContext cfg platform = stgToCmmPlatform cfg + int n = mkIntCLit platform n + + (cg_ipes, strtab) = flip runState emptyStringTable $ do + module_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (ppr this_mod) + mapM (toCgIPE platform ctx module_name) ents + + tables :: [CmmStatic] + tables = map (CmmStaticLit . CmmLabel . ipeInfoTablePtr) cg_ipes + + uncompressed_strings :: BS.ByteString + uncompressed_strings = getStringTableStrings strtab + + strings_bytes :: BS.ByteString + strings_bytes = compress defaultCompressionLevel uncompressed_strings + + strings :: [CmmStatic] + strings = [CmmString strings_bytes] + + uncompressed_entries :: BS.ByteString + uncompressed_entries = toIpeBufferEntries (platformByteOrder platform) cg_ipes - let (cg_ipes, strtab) = flip runState emptyStringTable $ do - module_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (ppr this_mod) - mapM (toCgIPE platform ctx module_name) ents - - let -- Emit the fields of an IpeBufferEntry struct. - toIpeBufferEntry :: CgInfoProvEnt -> [CmmLit] - toIpeBufferEntry cg_ipe = - [ CmmLabel (ipeInfoTablePtr cg_ipe) - , strtab_offset (ipeTableName cg_ipe) - , strtab_offset (ipeClosureDesc cg_ipe) - , strtab_offset (ipeTypeDesc cg_ipe) - , strtab_offset (ipeLabel cg_ipe) - , strtab_offset (ipeModuleName cg_ipe) - , strtab_offset (ipeSrcFile cg_ipe) - , strtab_offset (ipeSrcSpan cg_ipe) - , int32 0 - ] - - int n = mkIntCLit platform n - int32 n = CmmInt n W32 - strtab_offset (StrTabOffset n) = int32 (fromIntegral n) - - strings <- newByteStringCLit (getStringTableStrings strtab) - let lits = [ zeroCLit platform -- 'next' field - , strings -- 'strings' field - , int $ length cg_ipes -- 'count' field - ] ++ concatMap toIpeBufferEntry cg_ipes - emitDataLits (mkIPELabel this_mod) lits + entries_bytes :: BS.ByteString + entries_bytes = compress defaultCompressionLevel uncompressed_entries + + entries :: [CmmStatic] + entries = [CmmString entries_bytes] + + ipe_buffer_lbl :: CLabel + ipe_buffer_lbl = mkIPELabel this_mod + + ipe_buffer_node :: [CmmStatic] + ipe_buffer_node = map CmmStaticLit + [ -- 'next' field + zeroCLit platform + + -- 'compressed' field + , int do_compress + + -- 'count' field + , int $ length cg_ipes + + -- 'tables' field + , CmmLabel tables_lbl + + -- 'entries' field + , CmmLabel entries_lbl + + -- 'entries_size' field (decompressed size) + , int $ BS.length uncompressed_entries + + -- 'string_table' field + , CmmLabel strings_lbl + + -- 'string_table_size' field (decompressed size) + , int $ BS.length uncompressed_strings + ] + + -- Emit the list of info table pointers + emitDecl $ CmmData + (Section Data tables_lbl) + (CmmStaticsRaw tables_lbl tables) + + -- Emit the strings table + emitDecl $ CmmData + (Section Data strings_lbl) + (CmmStaticsRaw strings_lbl strings) + + -- Emit the list of IPE buffer entries + emitDecl $ CmmData + (Section Data entries_lbl) + (CmmStaticsRaw entries_lbl entries) + + -- Emit the IPE buffer list node + emitDecl $ CmmData + (Section Data ipe_buffer_lbl) + (CmmStaticsRaw ipe_buffer_lbl ipe_buffer_node) + +-- | Emit the fields of an IpeBufferEntry struct for each entry in a given list. +toIpeBufferEntries :: + ByteOrder -- ^ Byte order to write the data in + -> [CgInfoProvEnt] -- ^ List of IPE buffer entries + -> BS.ByteString +toIpeBufferEntries byte_order cg_ipes = + BSL.toStrict . BSB.toLazyByteString . mconcat + $ map (mconcat . map word32Builder . to_ipe_buf_ent) cg_ipes + where + to_ipe_buf_ent :: CgInfoProvEnt -> [Word32] + to_ipe_buf_ent cg_ipe = + [ ipeTableName cg_ipe + , ipeClosureDesc cg_ipe + , ipeTypeDesc cg_ipe + , ipeLabel cg_ipe + , ipeModuleName cg_ipe + , ipeSrcFile cg_ipe + , ipeSrcSpan cg_ipe + , 0 -- padding + ] + + word32Builder :: Word32 -> BSB.Builder + word32Builder = case byte_order of + BigEndian -> BSB.word32BE + LittleEndian -> BSB.word32LE toCgIPE :: Platform -> SDocContext -> StrTabOffset -> InfoProvEnt -> State StringTable CgInfoProvEnt toCgIPE platform ctx module_name ipe = do @@ -76,7 +197,7 @@ toCgIPE platform ctx module_name ipe = do coords = renderWithContext ctx (pprUserRealSpan False span) in (file, coords) label <- lookupStringTable $ ST.pack label_str - src_file <- lookupStringTable $ src_loc_file + src_file <- lookupStringTable src_loc_file src_span <- lookupStringTable $ ST.pack src_loc_span return $ CgInfoProvEnt { ipeInfoTablePtr = infoTablePtr ipe , ipeTableName = table_name @@ -104,7 +225,7 @@ data StringTable = StringTable { stStrings :: DList ShortText , stLookup :: !(M.Map ShortText StrTabOffset) } -newtype StrTabOffset = StrTabOffset Int +type StrTabOffset = Word32 emptyStringTable :: StringTable emptyStringTable = @@ -129,9 +250,50 @@ lookupStringTable str = state $ \st -> , stLength = stLength st + ST.byteLength str + 1 , stLookup = M.insert str res (stLookup st) } - res = StrTabOffset (stLength st) + res = fromIntegral (stLength st) in (res, st') +do_compress :: Int +compress :: Int -> BS.ByteString -> BS.ByteString +#if !defined(HAVE_LIBZSTD) +do_compress = 0 +compress _ bs = bs +#else +do_compress = 1 + +compress clvl (BSI.PS srcForeignPtr off len) = unsafePerformIO $ + withForeignPtr srcForeignPtr $ \srcPtr -> do + maxCompressedSize <- zstd_compress_bound $ fromIntegral len + dstForeignPtr <- BSI.mallocByteString (fromIntegral maxCompressedSize) + withForeignPtr dstForeignPtr $ \dstPtr -> do + compressedSize <- fromIntegral <$> + zstd_compress + dstPtr + maxCompressedSize + (srcPtr `plusPtr` off) + (fromIntegral len) + (fromIntegral clvl) + BSI.create compressedSize $ \p -> BSI.memcpy p dstPtr compressedSize + +foreign import ccall unsafe "ZSTD_compress" + zstd_compress :: + Ptr dst -- ^ Destination buffer + -> CSize -- ^ Capacity of destination buffer + -> Ptr src -- ^ Source buffer + -> CSize -- ^ Size of source buffer + -> CInt -- ^ Compression level + -> IO CSize + +-- | Compute the maximum compressed size for a given source buffer size +foreign import ccall unsafe "ZSTD_compressBound" + zstd_compress_bound :: + CSize -- ^ Size of source buffer + -> IO CSize +#endif + +defaultCompressionLevel :: Int +defaultCompressionLevel = 3 + newtype DList a = DList ([a] -> [a]) emptyDList :: DList a ===================================== compiler/GHC/StgToJS/Printer.hs ===================================== @@ -108,19 +108,17 @@ ghcjsRenderJsV r (JHash m) where quoteIfRequired :: FastString -> Doc quoteIfRequired x - | isUnquotedKey x' = text x' - | otherwise = PP.squotes (text x') - where x' = unpackFS x - - isUnquotedKey :: String -> Bool - isUnquotedKey x | null x = False - | all isDigit x = True - | otherwise = validFirstIdent (head x) - && all validOtherIdent (tail x) + | isUnquotedKey x = ftext x + | otherwise = PP.squotes (ftext x) + isUnquotedKey :: FastString -> Bool + isUnquotedKey fs = case unpackFS fs of + [] -> False + s@(c:cs) -> all isDigit s || (validFirstIdent c && all validOtherIdent cs) validFirstIdent c = c == '_' || c == '$' || isAlpha c validOtherIdent c = isAlpha c || isDigit c + ghcjsRenderJsV r v = renderJsV defaultRenderJs r v prettyBlock :: RenderJs -> [JStat] -> Doc ===================================== compiler/ghc.cabal.in ===================================== @@ -57,6 +57,10 @@ Flag build-tool-depends Description: Use build-tool-depends Default: True +Flag with-libzstd + Default: False + Manual: True + Library Default-Language: Haskell2010 Exposed: False @@ -71,6 +75,10 @@ Library if flag(build-tool-depends) build-tool-depends: alex:alex >= 3.2.6, happy:happy >= 1.20.0, genprimopcode:genprimopcode, deriveConstants:deriveConstants + if flag(with-libzstd) + extra-libraries: zstd + CPP-Options: -DHAVE_LIBZSTD + Build-Depends: base >= 4.11 && < 4.19, deepseq >= 1.4 && < 1.5, directory >= 1 && < 1.4, ===================================== configure.ac ===================================== @@ -1122,6 +1122,10 @@ AC_DEFINE_UNQUOTED([RTS_LINKER_USE_MMAP], [$RtsLinkerUseMmap], GHC_ADJUSTORS_METHOD([Target]) AC_SUBST([UseLibffiForAdjustors]) +dnl ** IPE data compression +dnl -------------------------------------------------------------- +FP_FIND_LIBZSTD + dnl ** Other RTS features dnl -------------------------------------------------------------- FP_FIND_LIBDW @@ -1267,6 +1271,17 @@ echo "\ makeinfo : $MAKEINFO git : $GIT cabal-install : $CABAL +" + +USING_LIBNUMA=$(if [ "$HaveLibNuma" = "1" ]; then echo "YES"; else echo "NO"; fi;) +USING_LIBZSTD=$(if [ "$HaveLibZstd" = "1" ]; then echo "YES"; else echo "NO"; fi;) +USING_LIBDW=$(if [ "$USE_LIBDW" = "1" ]; then echo "YES"; else echo "NO"; fi;) + +echo "\ + Using optional dependencies: + libnuma : $USING_LIBNUMA + libzstd : $USING_LIBZSTD + libdw : $USING_LIBDW Using LLVM tools clang : $ClangCmd ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -21,6 +21,17 @@ Compiler foo (\x -> x*2 + x) +- The compiler may now be configured to compress the debugging information + included in :ghc-flag:`-finfo-table-map` enabled binaries. To do so, one must + build GHC from source (see + `here` for directions) + and supply the ``--enable-ipe-data-compression`` flag to the ``configure`` + script. **Note**: This feature requires that the machine building GHC has + `libzstd `_ installed. + + In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map` + enabled build results was reduced by over 20% when compression was enabled. + GHCi ~~~~ ===================================== docs/users_guide/debug-info.rst ===================================== @@ -370,9 +370,23 @@ to a source location. This lookup table is generated by using the ``-finfo-table also want more precise information about constructor info tables then you should also use :ghc-flag:`-fdistinct-constructor-tables`. - This flag will increase the binary size by quite a lot, depending on how - big your project is. For compiling a project the size of GHC the overhead was - about 200 megabytes. + The :ghc-flag:`-finfo-table-map` flag will increase the binary size by quite + a lot, depending on how big your project is. For compiling a project the + size of GHC the overhead was about 200 megabytes. + + :since: 9.8 + + If you wish to reduce the size of :ghc-flag:`-finfo-table-map` enabled + binaries, consider building GHC from source and supplying the + ``--enable-ipe-data-compression`` flag to the ``configure`` script. This + will cause GHC to compress the :ghc-flag:`-finfo-table-map` related + debugging information included in binaries using the `libzstd + `_ compression library. **Note**: This + feature requires that the machine building GHC has + `libzstd `_ installed. + + In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map` + enabled build results was reduced by over 20% when compression was enabled. .. ghc-flag:: -fdistinct-constructor-tables :shortdesc: Generate a fresh info table for each usage ===================================== hadrian/cfg/system.config.in ===================================== @@ -200,10 +200,14 @@ libdw-lib-dir = @LibdwLibDir@ libnuma-include-dir = @LibNumaIncludeDir@ libnuma-lib-dir = @LibNumaLibDir@ +libzstd-include-dir = @LibZstdIncludeDir@ +libzstd-lib-dir = @LibZstdLibDir@ + # Optional Dependencies: #======================= use-lib-dw = @UseLibdw@ +use-lib-zstd = @UseLibZstd@ use-lib-numa = @UseLibNuma@ use-lib-m = @UseLibm@ use-lib-rt = @UseLibrt@ ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -35,6 +35,7 @@ data Flag = ArSupportsAtFile | UseLibffiForAdjustors | UseLibdw | UseLibnuma + | UseLibzstd | UseLibm | UseLibrt | UseLibdl @@ -65,6 +66,7 @@ flag f = do UseLibffiForAdjustors -> "use-libffi-for-adjustors" UseLibdw -> "use-lib-dw" UseLibnuma -> "use-lib-numa" + UseLibzstd -> "use-lib-zstd" UseLibm -> "use-lib-m" UseLibrt -> "use-lib-rt" UseLibdl -> "use-lib-dl" ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -60,6 +60,8 @@ data Setting = BuildArch | LibdwLibDir | LibnumaIncludeDir | LibnumaLibDir + | LibZstdIncludeDir + | LibZstdLibDir | LlvmTarget | ProjectGitCommitId | ProjectName @@ -162,6 +164,8 @@ setting key = lookupSystemConfig $ case key of LibdwLibDir -> "libdw-lib-dir" LibnumaIncludeDir -> "libnuma-include-dir" LibnumaLibDir -> "libnuma-lib-dir" + LibZstdIncludeDir -> "libzstd-include-dir" + LibZstdLibDir -> "libzstd-lib-dir" LlvmTarget -> "llvm-target" ProjectGitCommitId -> "project-git-commit-id" ProjectName -> "project-name" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -291,6 +291,7 @@ rtsCabalFlags = mconcat , flag "CabalNeedLibpthread" UseLibpthread , flag "CabalHaveLibbfd" UseLibbfd , flag "CabalHaveLibNuma" UseLibnuma + , flag "CabalHaveLibZstd" UseLibzstd , flag "CabalNeedLibatomic" NeedLibatomic , flag "CabalUseSystemLibFFI" UseSystemFfi , flag "CabalLibffiAdjustors" UseLibffiForAdjustors ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -77,6 +77,7 @@ packageArgs = do [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" , notM cross `cabalFlag` "terminfo" , arg "-build-tool-depends" + , flag UseLibzstd `cabalFlag` "with-libzstd" ] , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] @@ -286,6 +287,8 @@ rtsPackageArgs = package rts ? do libdwLibraryDir <- getSetting LibdwLibDir libnumaIncludeDir <- getSetting LibnumaIncludeDir libnumaLibraryDir <- getSetting LibnumaLibDir + libzstdIncludeDir <- getSetting LibZstdIncludeDir + libzstdLibraryDir <- getSetting LibZstdLibDir -- Arguments passed to GHC when compiling C and .cmm sources. let ghcArgs = mconcat @@ -392,6 +395,7 @@ rtsPackageArgs = package rts ? do , builder (Cabal Setup) ? mconcat [ cabalExtraDirs libdwIncludeDir libdwLibraryDir , cabalExtraDirs libnumaIncludeDir libnumaLibraryDir + , cabalExtraDirs libzstdIncludeDir libzstdLibraryDir , useSystemFfi ? cabalExtraDirs ffiIncludeDir ffiLibraryDir ] , builder (Cc (FindCDependencies CDep)) ? cArgs ===================================== m4/fp_find_libnuma.m4 ===================================== @@ -30,7 +30,7 @@ AC_DEFUN([FP_FIND_LIBNUMA], [Enable NUMA memory policy and thread affinity support in the runtime system via numactl's libnuma [default=auto]])]) - if test "$enable_numa" != "no" ; then + if test "$enable_numa" = "yes" ; then CFLAGS2="$CFLAGS" CFLAGS="$LIBNUMA_CFLAGS $CFLAGS" LDFLAGS2="$LDFLAGS" @@ -41,7 +41,7 @@ AC_DEFUN([FP_FIND_LIBNUMA], if test "$ac_cv_header_numa_h$ac_cv_header_numaif_h" = "yesyes" ; then AC_CHECK_LIB(numa, numa_available,HaveLibNuma=1) fi - if test "$enable_numa:$HaveLibNuma" = "yes:0" ; then + if test "$HaveLibNuma" = "0" ; then AC_MSG_ERROR([Cannot find system libnuma (required by --enable-numa)]) fi ===================================== m4/fp_find_libzstd.m4 ===================================== @@ -0,0 +1,79 @@ +AC_DEFUN([FP_FIND_LIBZSTD], +[ + dnl ** Is IPE data compression enabled? + dnl -------------------------------------------------------------- + AC_ARG_ENABLE( + ipe-data-compression, + [AS_HELP_STRING( + [--enable-ipe-data-compression], + [Enable compression of info table provenance entries using the + zstd compression library [default=no]] + )], + [FP_CAPITALIZE_YES_NO(["$enableval"], [EnableIpeDataCompression])], + [EnableIpeDataCompression=NO] + ) + + HaveLibZstd=0 + if test "$EnableIpeDataCompression" = "YES"; then + dnl ** Have zstd? + dnl -------------------------------------------------------------- + AC_ARG_WITH( + libzstd-libraries, + [AS_HELP_STRING( + [--with-libzstd-libraries=ARG], + [Find libraries for libzstd in ARG [default=system default]] + )], + [ + LibZstdLibDir="$withval" + LIBZSTD_LDFLAGS="-L$withval" + ] + ) + + AC_SUBST(LibZstdLibDir) + + AC_ARG_WITH( + libzstd-includes, + [AS_HELP_STRING( + [--with-libzstd-includes=ARG], + [Find includes for libzstd in ARG [default=system default]] + )], + [ + LibZstdIncludeDir="$withval" + LIBZSTD_CFLAGS="-I$withval" + ] + ) + + AC_SUBST(LibZstdIncludeDir) + + CFLAGS2="$CFLAGS" + CFLAGS="$LIBZSTD_CFLAGS $CFLAGS" + LDFLAGS2="$LDFLAGS" + LDFLAGS="$LIBZSTD_LDFLAGS $LDFLAGS" + + AC_CHECK_HEADERS([zstd.h]) + + if test "$ac_cv_header_zstd_h" = "yes" ; then + AC_CHECK_LIB(zstd,ZSTD_versionString,HaveLibZstd=1) + fi + if test "$HaveLibZstd" = "0" ; then + AC_MSG_ERROR( + [Cannot find system libzstd (required by + --enable-ipe-data-compression)] + ) + fi + + CFLAGS="$CFLAGS2" + LDFLAGS="$LDFLAGS2" + fi + + AC_DEFINE_UNQUOTED([HAVE_LIBZSTD], [$HaveLibZstd], [Define to 1 if you + wish to compress IPE data in compiler results (requires libzstd)]) + + if test $HaveLibZstd = "1" ; then + AC_SUBST([UseLibZstd],[YES]) + AC_SUBST([CabalHaveLibZstd],[True]) + else + AC_SUBST([UseLibZstd],[NO]) + AC_SUBST([CabalHaveLibZstd],[False]) + fi +]) ===================================== rts/IPE.c ===================================== @@ -20,6 +20,10 @@ #include #include +#if HAVE_LIBZSTD == 1 +#include +#endif + #if defined(TRACING) #include "Trace.h" #endif @@ -36,8 +40,9 @@ collecting IPE lists on registration. It's a singly linked list of IPE list buffers (IpeBufferListNode). These are emitted by the code generator, with generally one produced per module. Each -contains an array of IPE entries and a link field (which is used to link -buffers onto the pending list. +contains a pointer to a list of IPE entries, a pointer to a list of info +table pointers, and a link field (which is used to link buffers onto the +pending list. For reasons of space efficiency, IPE entries are represented slightly differently in the object file than the InfoProvEnt which we ultimately expose @@ -77,23 +82,23 @@ void exitIpe(void) { } #endif // THREADED_RTS -static InfoProvEnt ipeBufferEntryToIpe(const IpeBufferListNode *node, const IpeBufferEntry *ent) +static InfoProvEnt ipeBufferEntryToIpe(const char *strings, const StgInfoTable *tbl, const IpeBufferEntry ent) { - const char *strings = node->string_table; return (InfoProvEnt) { - .info = ent->info, + .info = tbl, .prov = { - .table_name = &strings[ent->table_name], - .closure_desc = &strings[ent->closure_desc], - .ty_desc = &strings[ent->ty_desc], - .label = &strings[ent->label], - .module = &strings[ent->module_name], - .src_file = &strings[ent->src_file], - .src_span = &strings[ent->src_span] + .table_name = &strings[ent.table_name], + .closure_desc = &strings[ent.closure_desc], + .ty_desc = &strings[ent.ty_desc], + .label = &strings[ent.label], + .module = &strings[ent.module_name], + .src_file = &strings[ent.src_file], + .src_span = &strings[ent.src_span] } }; } + #if defined(TRACING) static void traceIPEFromHashTable(void *data STG_UNUSED, StgWord key STG_UNUSED, const void *value) { @@ -105,8 +110,18 @@ void dumpIPEToEventLog(void) { // Dump pending entries IpeBufferListNode *cursor = RELAXED_LOAD(&ipeBufferList); while (cursor != NULL) { + IpeBufferEntry *entries; + char *strings; + + // Decompress if compressed + decompressIPEBufferListNodeIfCompressed(cursor, &entries, &strings); + for (uint32_t i = 0; i < cursor->count; i++) { - const InfoProvEnt ent = ipeBufferEntryToIpe(cursor, &cursor->entries[i]); + const InfoProvEnt ent = ipeBufferEntryToIpe( + strings, + cursor->tables[i], + entries[i] + ); traceIPE(&ent); } cursor = cursor->next; @@ -120,6 +135,7 @@ void dumpIPEToEventLog(void) { RELEASE_LOCK(&ipeMapLock); } + #else void dumpIPEToEventLog(void) { } @@ -169,16 +185,84 @@ void updateIpeMap() { } while (pending != NULL) { - IpeBufferListNode *currentNode = pending; - InfoProvEnt *ip_ents = stgMallocBytes(sizeof(InfoProvEnt) * currentNode->count, "updateIpeMap"); - for (uint32_t i = 0; i < currentNode->count; i++) { - const IpeBufferEntry *ent = ¤tNode->entries[i]; - ip_ents[i] = ipeBufferEntryToIpe(currentNode, ent); - insertHashTable(ipeMap, (StgWord) ent->info, &ip_ents[i]); + IpeBufferListNode *current_node = pending; + const IpeBufferEntry *entries; + const char *strings; + + // Decompress if compressed + decompressIPEBufferListNodeIfCompressed(current_node, &entries, &strings); + + // Convert the on-disk IPE buffer entry representation (IpeBufferEntry) + // into the runtime representation (InfoProvEnt) + InfoProvEnt *ip_ents = stgMallocBytes( + sizeof(InfoProvEnt) * current_node->count, + "updateIpeMap: ip_ents" + ); + for (uint32_t i = 0; i < current_node->count; i++) { + const IpeBufferEntry ent = entries[i]; + const StgInfoTable *tbl = current_node->tables[i]; + ip_ents[i] = ipeBufferEntryToIpe(strings, tbl, ent); + insertHashTable(ipeMap, (StgWord) tbl, &ip_ents[i]); } - pending = currentNode->next; + pending = current_node->next; } RELEASE_LOCK(&ipeMapLock); } + +/* Decompress the IPE data and strings table referenced by an IPE buffer list +node if it is compressed. No matter whether the data is compressed, the pointers +referenced by the 'entries_dst' and 'string_table_dst' parameters will point at +the decompressed IPE data and string table for the given node, respectively, +upon return from this function. +*/ +void decompressIPEBufferListNodeIfCompressed(IpeBufferListNode *node, IpeBufferEntry **entries_dst, char **string_table_dst) { + if (node->compressed) { + // The IPE list buffer node indicates that the strings table and + // entries list has been compressed. If zstd is not available, fail. + // If zstd is available, decompress. +#if HAVE_LIBZSTD == 0 + barf("An IPE buffer list node has been compressed, but the \ + decompression library (zstd) is not available."); +#else + size_t compressed_sz = ZSTD_findFrameCompressedSize( + node->string_table, + node->string_table_size + ); + char *decompressed_strings = stgMallocBytes( + node->string_table_size, + "updateIpeMap: decompressed_strings" + ); + ZSTD_decompress( + decompressed_strings, + node->string_table_size, + node->string_table, + compressed_sz + ); + *string_table_dst = decompressed_strings; + + // Decompress the IPE data + compressed_sz = ZSTD_findFrameCompressedSize( + node->entries, + node->entries_size + ); + void *decompressed_entries = stgMallocBytes( + node->entries_size, + "updateIpeMap: decompressed_entries" + ); + ZSTD_decompress( + decompressed_entries, + node->entries_size, + node->entries, + compressed_sz + ); + *entries_dst = decompressed_entries; +#endif // HAVE_LIBZSTD == 0 + + } else { + // Not compressed, no need to decompress + *entries_dst = node->entries; + *string_table_dst = node->string_table; + } +} ===================================== rts/IPE.h ===================================== @@ -17,5 +17,6 @@ void dumpIPEToEventLog(void); void updateIpeMap(void); void initIpe(void); void exitIpe(void); +void decompressIPEBufferListNodeIfCompressed(IpeBufferListNode*, IpeBufferEntry**, char**); #include "EndPrivate.h" ===================================== rts/include/rts/IPE.h ===================================== @@ -52,9 +52,6 @@ typedef uint32_t StringIdx; // The size of this must be a multiple of the word size // to ensure correct packing. typedef struct { - // When TNTC is enabled this will point to the entry code - // not the info table itself. - const StgInfoTable *info; StringIdx table_name; StringIdx closure_desc; StringIdx ty_desc; @@ -69,10 +66,23 @@ GHC_STATIC_ASSERT(sizeof(IpeBufferEntry) % (WORD_SIZE_IN_BITS / 8) == 0, "sizeof typedef struct IpeBufferListNode_ { struct IpeBufferListNode_ *next; + // Everything below is read-only and generated by the codegen - const char *string_table; + + // This flag should be treated as a boolean + StgWord compressed; + StgWord count; - IpeBufferEntry entries[]; + + // When TNTC is enabled, these will point to the entry code + // not the info table itself. + StgInfoTable **tables; + + IpeBufferEntry *entries; + StgWord entries_size; // decompressed size + + char *string_table; + StgWord string_table_size; // decompressed size } IpeBufferListNode; void registerInfoProvList(IpeBufferListNode *node); ===================================== rts/rts.cabal.in ===================================== @@ -45,6 +45,8 @@ flag libdw default: @CabalHaveLibdw@ flag libnuma default: @CabalHaveLibNuma@ +flag libzstd + default: @CabalHaveLibZstd@ flag 64bit default: @Cabal64bit@ flag leading-underscore @@ -212,6 +214,8 @@ library extra-libraries: elf dw if flag(libnuma) extra-libraries: numa + if flag(libzstd) + extra-libraries: zstd if !flag(smp) cpp-options: -DNOSMP ===================================== testsuite/driver/runtests.py ===================================== @@ -601,6 +601,7 @@ else: if args.junit: junit(t).write(args.junit) + args.junit.close() if config.only_report_hadrian_deps: print("WARNING - skipping all tests and only reporting required hadrian dependencies:", config.hadrian_deps) ===================================== testsuite/driver/testlib.py ===================================== @@ -1347,7 +1347,7 @@ def do_test(name: TestName, # if found and instead have the testsuite decide on what to do # with the output. def override_options(pre_cmd): - if config.verbose >= 5 and bool(re.match('\$make', pre_cmd, re.I)): + if config.verbose >= 5 and bool(re.match(r'\$make', pre_cmd, re.I)): return pre_cmd.replace(' -s' , '') \ .replace('--silent', '') \ .replace('--quiet' , '') @@ -1989,7 +1989,7 @@ def split_file(in_fn: Path, delimiter: str, out1_fn: Path, out2_fn: Path): with out1_fn.open('w', encoding='utf8', newline='') as out1: with out2_fn.open('w', encoding='utf8', newline='') as out2: line = infile.readline() - while re.sub('^\s*','',line) != delimiter and line != '': + while re.sub(r'^\s*','',line) != delimiter and line != '': out1.write(line) line = infile.readline() @@ -2399,20 +2399,20 @@ def normalise_errmsg(s: str) -> str: # warning message to get clean output. if config.msys: s = re.sub('Failed to remove file (.*); error= (.*)$', '', s) - s = re.sub('DeleteFile "(.+)": permission denied \(Access is denied\.\)(.*)$', '', s) + s = re.sub(r'DeleteFile "(.+)": permission denied \(Access is denied\.\)(.*)$', '', s) # filter out unsupported GNU_PROPERTY_TYPE (5), which is emitted by LLVM10 # and not understood by older binutils (ar, ranlib, ...) - s = modify_lines(s, lambda l: re.sub('^(.+)warning: (.+): unsupported GNU_PROPERTY_TYPE \(5\) type: 0xc000000(.*)$', '', l)) + s = modify_lines(s, lambda l: re.sub(r'^(.+)warning: (.+): unsupported GNU_PROPERTY_TYPE \(5\) type: 0xc000000(.*)$', '', l)) - s = re.sub('ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) + s = re.sub(r'ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) s = re.sub('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version','',s) # ignore superfluous dylibs passed to the linker. s = re.sub('ld: warning: .*, ignoring unexpected dylib file\n','',s) # ignore LLVM Version mismatch garbage; this will just break tests. s = re.sub('You are using an unsupported version of LLVM!.*\n','',s) - s = re.sub('Currently only [\.0-9]+ is supported. System LLVM version: [\.0-9]+.*\n','',s) - s = re.sub('We will try though\.\.\..*\n','',s) + s = re.sub('Currently only [\\.0-9]+ is supported. System LLVM version: [\\.0-9]+.*\n','',s) + s = re.sub('We will try though\\.\\.\\..*\n','',s) # ignore warning about strip invalidating signatures s = re.sub('.*strip: changes being made to the file will invalidate the code signature in.*\n','',s) # clang may warn about unused argument when used as assembler @@ -2475,8 +2475,8 @@ def normalise_slashes_( s: str ) -> str: return s def normalise_exe_( s: str ) -> str: - s = re.sub('\.exe', '', s) - s = re.sub('\.jsexe', '', s) + s = re.sub(r'\.exe', '', s) + s = re.sub(r'\.jsexe', '', s) return s def normalise_output( s: str ) -> str: @@ -2494,14 +2494,14 @@ def normalise_output( s: str ) -> str: # ghci outputs are pretty unstable with -fexternal-dynamic-refs, which is # requires for -fPIC s = re.sub(' -fexternal-dynamic-refs\n','',s) - s = re.sub('ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) + s = re.sub(r'ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) s = re.sub('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version','',s) # ignore superfluous dylibs passed to the linker. s = re.sub('ld: warning: .*, ignoring unexpected dylib file\n','',s) # ignore LLVM Version mismatch garbage; this will just break tests. s = re.sub('You are using an unsupported version of LLVM!.*\n','',s) - s = re.sub('Currently only [\.0-9]+ is supported. System LLVM version: [\.0-9]+.*\n','',s) - s = re.sub('We will try though\.\.\..*\n','',s) + s = re.sub('Currently only [\\.0-9]+ is supported. System LLVM version: [\\.0-9]+.*\n','',s) + s = re.sub('We will try though\\.\\.\\..*\n','',s) # ignore warning about strip invalidating signatures s = re.sub('.*strip: changes being made to the file will invalidate the code signature in.*\n','',s) # clang may warn about unused argument when used as assembler ===================================== testsuite/tests/rts/ipe/ipeEventLog_fromMap.c ===================================== @@ -19,7 +19,7 @@ int main(int argc, char *argv[]) { registerInfoProvList(list2); // Query an IPE to initialize the underlying hash map. - lookupIPE(list1->entries[0].info); + lookupIPE(list1->tables[0]); // Trace all IPE events. dumpIPEToEventLog(); ===================================== testsuite/tests/rts/ipe/ipeMap.c ===================================== @@ -40,15 +40,23 @@ void shouldFindNothingInAnEmptyIPEMap(Capability *cap) { } HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) { - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + sizeof(IpeBufferEntry)); + // Allocate buffers for IPE buffer list node + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); + node->tables = malloc(sizeof(StgInfoTable *)); + node->entries = malloc(sizeof(IpeBufferEntry)); + StringTable st; init_string_table(&st); HaskellObj fortyTwo = UNTAG_CLOSURE(rts_mkInt(cap, 42)); - node->entries[0] = makeAnyProvEntry(cap, &st, fortyTwo, 42); - node->count = 1; node->next = NULL; + node->compressed = 0; + node->count = 1; + node->tables[0] = get_itbl(fortyTwo); + node->entries[0] = makeAnyProvEntry(cap, &st, 42); + node->entries_size = sizeof(IpeBufferEntry); node->string_table = st.buffer; + node->string_table_size = st.size; registerInfoProvList(node); @@ -72,15 +80,23 @@ HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) { void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap, HaskellObj fortyTwo) { - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + sizeof(IpeBufferEntry)); + // Allocate buffers for IPE buffer list node + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); + node->tables = malloc(sizeof(StgInfoTable *)); + node->entries = malloc(sizeof(IpeBufferEntry)); + StringTable st; init_string_table(&st); HaskellObj twentyThree = UNTAG_CLOSURE(rts_mkInt8(cap, 23)); - node->entries[0] = makeAnyProvEntry(cap, &st, twentyThree, 23); - node->count = 1; node->next = NULL; + node->compressed = 0; + node->count = 1; + node->tables[0] = get_itbl(twentyThree); + node->entries[0] = makeAnyProvEntry(cap, &st, 23); + node->entries_size = sizeof(IpeBufferEntry); node->string_table = st.buffer; + node->string_table_size = st.size; registerInfoProvList(node); @@ -103,17 +119,26 @@ void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap, } void shouldFindTwoFromTheSameList(Capability *cap) { - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + 2 * sizeof(IpeBufferEntry)); + // Allocate buffers for IPE buffer list node + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); + node->tables = malloc(sizeof(StgInfoTable *) * 2); + node->entries = malloc(sizeof(IpeBufferEntry) * 2); + StringTable st; init_string_table(&st); HaskellObj one = UNTAG_CLOSURE(rts_mkInt16(cap, 1)); HaskellObj two = UNTAG_CLOSURE(rts_mkInt32(cap, 2)); - node->entries[0] = makeAnyProvEntry(cap, &st, one, 1); - node->entries[1] = makeAnyProvEntry(cap, &st, two, 2); - node->count = 2; node->next = NULL; + node->compressed = 0; + node->count = 2; + node->tables[0] = get_itbl(one); + node->tables[1] = get_itbl(two); + node->entries[0] = makeAnyProvEntry(cap, &st, 1); + node->entries[1] = makeAnyProvEntry(cap, &st, 2); + node->entries_size = sizeof(IpeBufferEntry) * 2; node->string_table = st.buffer; + node->string_table_size = st.size; registerInfoProvList(node); ===================================== testsuite/tests/rts/ipe/ipe_lib.c ===================================== @@ -25,9 +25,8 @@ uint32_t add_string(StringTable *st, const char *s) { return n; } -IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj closure, int i) { +IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, int i) { IpeBufferEntry provEnt; - provEnt.info = get_itbl(closure); unsigned int tableNameLength = strlen("table_name_") + 3 /* digits */ + 1 /* null character */; char *tableName = malloc(sizeof(char) * tableNameLength); @@ -69,15 +68,27 @@ IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj clo IpeBufferListNode *makeAnyProvEntries(Capability *cap, int start, int end) { const int n = end - start; - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + n * sizeof(IpeBufferEntry)); + + // Allocate buffers for IpeBufferListNode + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); + node->tables = malloc(sizeof(StgInfoTable *) * n); + node->entries = malloc(sizeof(IpeBufferEntry) * n); + StringTable st; init_string_table(&st); + + // Make the entries and fill the buffers for (int i=start; i < end; i++) { HaskellObj closure = rts_mkInt(cap, 42); - node->entries[i] = makeAnyProvEntry(cap, &st, closure, i); + node->tables[i] = get_itbl(closure); + node->entries[i] = makeAnyProvEntry(cap, &st, i); } + + // Set the rest of the fields node->next = NULL; + node->compressed = 0; node->count = n; node->string_table = st.buffer; + return node; } ===================================== testsuite/tests/rts/ipe/ipe_lib.h ===================================== @@ -12,6 +12,6 @@ void init_string_table(StringTable *st); uint32_t add_string(StringTable *st, const char *s); IpeBufferListNode *makeAnyProvEntries(Capability *cap, int start, int end); -IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj closure, int i); +IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, int i); void dumpIPEToEventLog(void); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/76f179c87bec4465b3316c0c29ecdc80a204b826...2142c4481197b5544d42a9937763812168be9e4b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/76f179c87bec4465b3316c0c29ecdc80a204b826...2142c4481197b5544d42a9937763812168be9e4b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 16:10:50 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Wed, 08 Feb 2023 11:10:50 -0500 Subject: [Git][ghc/ghc][wip/js-rts-fixmes] JS RTS: use jsClosureCount for closureConstructors and cache sizes Message-ID: <63e3c98adcb76_2b039a527ec43234@gitlab.mail> Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC Commits: 3059b3f7 by Josh Meredith at 2023-02-08T16:10:33+00:00 JS RTS: use jsClosureCount for closureConstructors and cache sizes - - - - - 2 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -133,6 +133,7 @@ module GHC.JS.Make , clsName , dataFieldName, dataFieldNames , varName, varNames + , jsClosureCount ) where @@ -645,7 +646,10 @@ dataFieldCache :: Array Int FastString dataFieldCache = listArray (0,nFieldCache) (map (mkFastString . ('d':) . show) [(0::Int)..nFieldCache]) nFieldCache :: Int -nFieldCache = 16384 +nFieldCache = 128 + +jsClosureCount :: Int +jsClosureCount = 24 dataFieldName :: Int -> FastString dataFieldName i @@ -658,39 +662,39 @@ dataFieldNames = fmap dataFieldName [1..nFieldCache] -- | Cache "h$dXXX" names dataCache :: Array Int FastString -dataCache = listArray (0,63) (map (mkFastString . ("h$d"++) . show) [(0::Int)..63]) +dataCache = listArray (0,nFieldCache) (map (mkFastString . ("h$d"++) . show) [(0::Int)..nFieldCache]) dataName :: Int -> FastString dataName i - | i < 0 || i > 63 = panic "dataCacheName" (ppr i) - | otherwise = dataCache ! i + | i < 0 || i > nFieldCache = panic "dataCacheName" (ppr i) + | otherwise = dataCache ! i allocData :: Int -> JExpr allocData i = toJExpr (TxtI (dataCache ! i)) -- | Cache "h$cXXX" names clsCache :: Array Int FastString -clsCache = listArray (0,63) (map (mkFastString . ("h$c"++) . show) [(0::Int)..63]) +clsCache = listArray (0,jsClosureCount) (map (mkFastString . ("h$c"++) . show) [(0::Int)..jsClosureCount]) clsName :: Int -> FastString clsName i - | i < 0 || i > 63 = panic "clsCacheName" (ppr i) - | otherwise = clsCache ! i + | i < 0 || i > jsClosureCount = panic "clsCacheName" (ppr i) + | otherwise = clsCache ! i allocClsA :: Int -> JExpr allocClsA i = toJExpr (TxtI (clsCache ! i)) -- | Cache "xXXX" names varCache :: Array Int FastString -varCache = listArray (0,63) (map (mkFastString . ('x':) . show) [(0::Int)..63]) +varCache = listArray (0,jsClosureCount) (map (mkFastString . ('x':) . show) [(0::Int)..jsClosureCount]) varName :: Int -> Ident varName i - | i < 0 || i > 63 = panic "varCacheName" (ppr i) - | otherwise = TxtI $ varCache ! i + | i < 0 || i > jsClosureCount = panic "varCacheName" (ppr i) + | otherwise = TxtI $ varCache ! i varNames :: [Ident] -varNames = fmap varName [1..63] +varNames = fmap varName [1..jsClosureCount] -------------------------------------------------------------------------------- ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -81,8 +81,8 @@ resetResultVar r = toJExpr r |= null_ -- JIT can optimize better. closureConstructors :: StgToJSConfig -> JStat closureConstructors s = BlockStat - [ mconcat (map mkClosureCon (Nothing : map Just [0..24])) - , mconcat (map mkDataFill [1..24]) + [ mconcat (map mkClosureCon (Nothing : map Just [0..jsClosureCount])) + , mconcat (map mkDataFill [1..jsClosureCount]) ] where prof = csProf s View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3059b3f7e5837b5b89994d4e08adc764658f3c4e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3059b3f7e5837b5b89994d4e08adc764658f3c4e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 16:59:19 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 08 Feb 2023 11:59:19 -0500 Subject: [Git][ghc/ghc][wip/T22834] 114 commits: Hadrian: correctly detect AR at-file support Message-ID: <63e3d4e712b97_2b039a5274c54069@gitlab.mail> Ben Gamari pushed to branch wip/T22834 at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 1bd32a35 by Sylvain Henry at 2023-01-26T12:34:21-05:00 Factorize hptModulesBelow Create and use moduleGraphModulesBelow in GHC.Unit.Module.Graph that doesn't need anything from the driver to be used. - - - - - 1262d3f8 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Store dehydrated data structures in CgModBreaks This fixes a tricky leak in GHCi where we were retaining old copies of HscEnvs when reloading. If not all modules were recompiled then these hydrated fields in break points would retain a reference to the old HscEnv which could double memory usage. Fixes #22530 - - - - - e27eb80c by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force more in NFData Name instance Doesn't force the lazy `OccName` field (#19619) which is already known as a really bad source of leaks. When we slam the hammer storing Names on disk (in interface files or the like), all this should be forced as otherwise a `Name` can easily retain an `Id` and hence the entire world. Fixes #22833 - - - - - 3d004d5a by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force OccName in tidyTopName This occname has just been derived from an `Id`, so need to force it promptly so we can release the Id back to the world. Another symptom of the bug caused by #19619 - - - - - f2a0fea0 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Strict fields in ModNodeKey (otherwise retains HomeModInfo) Towards #22530 - - - - - 5640cb1d by Sylvain Henry at 2023-01-26T12:35:36-05:00 Hadrian: fix doc generation Was missing dependencies on files generated by templates (e.g. ghc.cabal) - - - - - 3e827c3f by Richard Eisenberg at 2023-01-26T20:06:53-05:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. - - - - - b3ef5c89 by doyougnu at 2023-01-26T20:07:48-05:00 tryFillBuffer: strictify more speculative bangs - - - - - d0d7ba0f by Vladislav Zavialov at 2023-01-26T20:08:25-05:00 base: NoImplicitPrelude in Data.Void and Data.Kind This change removes an unnecessary dependency on Prelude from two modules in the base package. - - - - - fa1db923 by Matthew Pickering at 2023-01-26T20:09:00-05: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 - - - - - 807310a1 by Matthew Pickering at 2023-01-26T20:09:00-05:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. - - - - - c7116b10 by Ben Gamari at 2023-01-26T20:09:35-05:00 base: Make changelog proposal references more consistent Addresses #22773. - - - - - 6932cfc7 by Sylvain Henry at 2023-01-26T20:10:27-05:00 Fix spurious change from !9568 - - - - - e480fbc2 by Ben Gamari at 2023-01-27T05:01:24-05:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 - - - - - 2648c09c by Andrei Borzenkov at 2023-01-27T05:02:07-05:00 Replace errors from badOrigBinding with new one (#22839) Problem: in 02279a9c the type-level [] syntax was changed from a built-in name to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if a name is not built-in then it must have come from TH quotation, but this is not necessarily the case with []. The outdated assumption in badOrigBinding leads to incorrect error messages. This code: data [] Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []" Unfortunately, there is not enough information in RdrName to directly determine if the name was constructed via TH or by the parser, so this patch changes the error message instead. It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote into a new error TcRnBindingOfExistingName and changes its wording to avoid guessing the origin of the name. - - - - - 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - df3edc69 by Ben Gamari at 2023-02-08T11:57:44-05:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - 578965bd by Ben Gamari at 2023-02-08T11:58:59-05:00 nativeGen: Explicitly set section types TODO - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - cabal.project-reinstall - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Reg.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/BlockLayout.hs - compiler/GHC/CmmToAsm/Dwarf.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6496a458aeb04e3e4e08a616b7c10f25f666091b...578965bdf13028fb7e0c2f6661424857580a7d95 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6496a458aeb04e3e4e08a616b7c10f25f666091b...578965bdf13028fb7e0c2f6661424857580a7d95 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 16:59:55 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 08 Feb 2023 11:59:55 -0500 Subject: [Git][ghc/ghc][wip/T22834] nativeGen: Set explicit section types on all platforms Message-ID: <63e3d50bce87a_2b039a5267054233@gitlab.mail> Ben Gamari pushed to branch wip/T22834 at Glasgow Haskell Compiler / GHC Commits: 3d16a52e by Ben Gamari at 2023-02-08T11:59:40-05:00 nativeGen: Set explicit section types on all platforms - - - - - 1 changed file: - compiler/GHC/CmmToAsm/Ppr.hs Changes: ===================================== compiler/GHC/CmmToAsm/Ppr.hs ===================================== @@ -248,6 +248,7 @@ pprGNUSectionHeader config t suffix = Text | OSMinGW32 <- platformOS platform -> text ",\"xr\"" + | otherwise -> text ",\"ax\"," <> sectionType platform "progbits" CString | OSMinGW32 <- platformOS platform -> empty View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3d16a52e3ef5be9a67e79f7666f90bc5eb25ef64 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3d16a52e3ef5be9a67e79f7666f90bc5eb25ef64 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 17:38:33 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 08 Feb 2023 12:38:33 -0500 Subject: [Git][ghc/ghc][wip/T22834] 2 commits: nativeGen: Explicitly set flags of text sections on Windows Message-ID: <63e3de199f3bc_2b039a52670581bf@gitlab.mail> Ben Gamari pushed to branch wip/T22834 at Glasgow Haskell Compiler / GHC Commits: ca1577fc by Ben Gamari at 2023-02-08T12:38:27-05:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - 855f4c9b by Ben Gamari at 2023-02-08T12:38:27-05:00 nativeGen: Set explicit section types on all platforms - - - - - 4 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/CmmToAsm/Ppr.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -502,7 +502,7 @@ doc-tarball: optional: true - job: nightly-x86_64-windows-validate optional: true - - job: release-x86_64-windows-release+no_split_sections + - job: release-x86_64-windows-release optional: true tags: @@ -526,7 +526,7 @@ doc-tarball: || mv "ghc-x86_64-linux-deb10-release.tar.xz" "$LINUX_BINDIST" \ || true mv "ghc-x86_64-windows-validate.tar.xz" "$WINDOWS_BINDIST" \ - || mv "ghc-x86_64-windows-release+no_split_sections.tar.xz" "$WINDOWS_BINDIST" \ + || mv "ghc-x86_64-windows-release.tar.xz" "$WINDOWS_BINDIST" \ || true if [ ! -f "$LINUX_BINDIST" ]; then echo "Error: $LINUX_BINDIST does not exist. Did the Debian 9 job fail?" ===================================== .gitlab/gen_ci.hs ===================================== @@ -871,8 +871,8 @@ job_groups = -- This job is only for generating head.hackage docs , hackage_doc_job (disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig)) , disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) dwarf) - , fastCI (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken vanilla)) - , disableValidate (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken nativeInt)) + , fastCI (standardBuildsWithConfig Amd64 Windows vanilla) + , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt) , standardBuilds Amd64 Darwin , allowFailureGroup (addValidateRule FreeBSDLabel (validateBuilds Amd64 FreeBSD13 vanilla)) , standardBuilds AArch64 Darwin ===================================== .gitlab/jobs.yaml ===================================== @@ -2173,7 +2173,7 @@ "XZ_OPT": "-9" } }, - "release-aarch64-linux-deb10-release+no_split_sections": { + "release-aarch64-linux-deb10-release": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2183,7 +2183,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-aarch64-linux-deb10-release+no_split_sections.tar.xz", + "ghc-aarch64-linux-deb10-release.tar.xz", "junit.xml" ], "reports": { @@ -2225,15 +2225,15 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-release+no_split_sections", - "BUILD_FLAVOUR": "release+no_split_sections", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-release", + "BUILD_FLAVOUR": "release", "CONFIGURE_ARGS": "", "IGNORE_PERF_FAILURES": "all", - "TEST_ENV": "aarch64-linux-deb10-release+no_split_sections", + "TEST_ENV": "aarch64-linux-deb10-release", "XZ_OPT": "-9" } }, - "release-i386-linux-deb9-release+no_split_sections": { + "release-i386-linux-deb9-release": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2243,7 +2243,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-i386-linux-deb9-release+no_split_sections.tar.xz", + "ghc-i386-linux-deb9-release.tar.xz", "junit.xml" ], "reports": { @@ -2285,11 +2285,11 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-release+no_split_sections", - "BUILD_FLAVOUR": "release+no_split_sections", + "BIN_DIST_NAME": "ghc-i386-linux-deb9-release", + "BUILD_FLAVOUR": "release", "CONFIGURE_ARGS": "", "IGNORE_PERF_FAILURES": "all", - "TEST_ENV": "i386-linux-deb9-release+no_split_sections", + "TEST_ENV": "i386-linux-deb9-release", "XZ_OPT": "-9" } }, @@ -2423,7 +2423,7 @@ "XZ_OPT": "-9" } }, - "release-x86_64-linux-alpine3_12-release+fully_static+no_split_sections": { + "release-x86_64-linux-alpine3_12-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2433,7 +2433,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections.tar.xz", + "ghc-x86_64-linux-alpine3_12-release+fully_static.tar.xz", "junit.xml" ], "reports": { @@ -2476,18 +2476,18 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections", + "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+fully_static", "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native", - "BUILD_FLAVOUR": "release+fully_static+no_split_sections", + "BUILD_FLAVOUR": "release+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", - "TEST_ENV": "x86_64-linux-alpine3_12-release+fully_static+no_split_sections", + "TEST_ENV": "x86_64-linux-alpine3_12-release+fully_static", "XZ_OPT": "-9" } }, - "release-x86_64-linux-centos7-release+no_split_sections": { + "release-x86_64-linux-centos7-release": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2497,7 +2497,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-linux-centos7-release+no_split_sections.tar.xz", + "ghc-x86_64-linux-centos7-release.tar.xz", "junit.xml" ], "reports": { @@ -2539,12 +2539,12 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-centos7-release+no_split_sections", - "BUILD_FLAVOUR": "release+no_split_sections", + "BIN_DIST_NAME": "ghc-x86_64-linux-centos7-release", + "BUILD_FLAVOUR": "release", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", - "TEST_ENV": "x86_64-linux-centos7-release+no_split_sections", + "TEST_ENV": "x86_64-linux-centos7-release", "XZ_OPT": "-9" } }, @@ -2728,7 +2728,7 @@ "XZ_OPT": "-9" } }, - "release-x86_64-linux-deb9-release+no_split_sections": { + "release-x86_64-linux-deb9-release": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2738,7 +2738,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-linux-deb9-release+no_split_sections.tar.xz", + "ghc-x86_64-linux-deb9-release.tar.xz", "junit.xml" ], "reports": { @@ -2780,11 +2780,11 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb9-release+no_split_sections", - "BUILD_FLAVOUR": "release+no_split_sections", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb9-release", + "BUILD_FLAVOUR": "release", "CONFIGURE_ARGS": "", "IGNORE_PERF_FAILURES": "all", - "TEST_ENV": "x86_64-linux-deb9-release+no_split_sections", + "TEST_ENV": "x86_64-linux-deb9-release", "XZ_OPT": "-9" } }, @@ -3156,7 +3156,7 @@ "XZ_OPT": "-9" } }, - "release-x86_64-windows-int_native-release+no_split_sections": { + "release-x86_64-windows-int_native-release": { "after_script": [ "bash .gitlab/ci.sh save_cache", "bash .gitlab/ci.sh clean" @@ -3165,7 +3165,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-windows-int_native-release+no_split_sections.tar.xz", + "ghc-x86_64-windows-int_native-release.tar.xz", "junit.xml" ], "reports": { @@ -3203,8 +3203,8 @@ ], "variables": { "BIGNUM_BACKEND": "native", - "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-release+no_split_sections", - "BUILD_FLAVOUR": "release+no_split_sections", + "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-release", + "BUILD_FLAVOUR": "release", "CABAL_INSTALL_VERSION": "3.8.1.0", "CONFIGURE_ARGS": "", "GHC_VERSION": "9.4.3", @@ -3212,11 +3212,11 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", - "TEST_ENV": "x86_64-windows-int_native-release+no_split_sections", + "TEST_ENV": "x86_64-windows-int_native-release", "XZ_OPT": "-9" } }, - "release-x86_64-windows-release+no_split_sections": { + "release-x86_64-windows-release": { "after_script": [ "bash .gitlab/ci.sh save_cache", "bash .gitlab/ci.sh clean" @@ -3225,7 +3225,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-windows-release+no_split_sections.tar.xz", + "ghc-x86_64-windows-release.tar.xz", "junit.xml" ], "reports": { @@ -3263,8 +3263,8 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-windows-release+no_split_sections", - "BUILD_FLAVOUR": "release+no_split_sections", + "BIN_DIST_NAME": "ghc-x86_64-windows-release", + "BUILD_FLAVOUR": "release", "CABAL_INSTALL_VERSION": "3.8.1.0", "CONFIGURE_ARGS": "", "GHC_VERSION": "9.4.3", @@ -3272,7 +3272,7 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", - "TEST_ENV": "x86_64-windows-release+no_split_sections", + "TEST_ENV": "x86_64-windows-release", "XZ_OPT": "-9" } }, ===================================== compiler/GHC/CmmToAsm/Ppr.hs ===================================== @@ -245,6 +245,10 @@ pprGNUSectionHeader config t suffix = OtherSection _ -> panic "PprBase.pprGNUSectionHeader: unknown section type" flags = case t of + Text + | OSMinGW32 <- platformOS platform + -> text ",\"xr\"" + | otherwise -> text ",\"ax\"," <> sectionType platform "progbits" CString | OSMinGW32 <- platformOS platform -> empty View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3d16a52e3ef5be9a67e79f7666f90bc5eb25ef64...855f4c9b3eda9333fb7006692fec1c7d87745c09 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3d16a52e3ef5be9a67e79f7666f90bc5eb25ef64...855f4c9b3eda9333fb7006692fec1c7d87745c09 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 17:58:54 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 08 Feb 2023 12:58:54 -0500 Subject: [Git][ghc/ghc][wip/rts-warnings] 5 commits: rts: Fix incorrect #include Message-ID: <63e3e2de30240_2b039a5267059578@gitlab.mail> Ben Gamari pushed to branch wip/rts-warnings at Glasgow Haskell Compiler / GHC Commits: 19d3431f by Ben Gamari at 2023-02-08T12:39:28-05:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - bc271a31 by Ben Gamari at 2023-02-08T12:39:28-05:00 nonmoving: Fix unused definition warrnings - - - - - 58ad9b0b by Ben Gamari at 2023-02-08T12:39:28-05:00 hadrian: Ensure that -Werror is passed to C compilations Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. - - - - - 062f5b2d by Ben Gamari at 2023-02-08T12:39:28-05:00 Disable futimens on Darwin. See #22938 - - - - - e63d0cb8 by Ben Gamari at 2023-02-08T12:40:58-05:00 rts: Fix incorrect CPP guard - - - - - 7 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - hadrian/src/Flavour.hs - rts/posix/Ticker.c - rts/posix/ticker/Pthread.c - rts/posix/ticker/TimerFd.c - rts/sm/NonMovingMark.c Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -391,6 +391,8 @@ opsysVariables Amd64 (Darwin {}) = , "ac_cv_func_clock_gettime" =: "no" -- # Only newer OS Xs support utimensat. See #17895 , "ac_cv_func_utimensat" =: "no" + -- # Only newer OS Xs support futimens. See #22938 + , "ac_cv_func_futimens" =: "no" , "LANG" =: "en_US.UTF-8" , "CONFIGURE_ARGS" =: "--with-intree-gmp --with-system-libffi" -- Fonts can't be installed on darwin ===================================== .gitlab/jobs.yaml ===================================== @@ -480,6 +480,7 @@ "TEST_ENV": "x86_64-darwin-validate", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", + "ac_cv_func_futimens": "no", "ac_cv_func_utimensat": "no" } }, @@ -2356,6 +2357,7 @@ "TEST_ENV": "x86_64-darwin-release", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", + "ac_cv_func_futimens": "no", "ac_cv_func_utimensat": "no" } }, @@ -3337,6 +3339,7 @@ "NIX_SYSTEM": "x86_64-darwin", "TEST_ENV": "x86_64-darwin-validate", "ac_cv_func_clock_gettime": "no", + "ac_cv_func_futimens": "no", "ac_cv_func_utimensat": "no" } }, ===================================== hadrian/src/Flavour.hs ===================================== @@ -122,16 +122,22 @@ addArgs args' fl = fl { args = args fl <> args' } -- from warnings. werror :: Flavour -> Flavour werror = - addArgs - ( builder Ghc + addArgs $ mconcat + [ builder Ghc ? notStage0 ? mconcat - [ arg "-Werror", - flag CrossCompiling + [ arg "-Werror" + , arg "-optc-Werror" + , arg "-optc-Wno-error=unknown-pragmas" + , flag CrossCompiling ? package unix ? mconcat [arg "-Wwarn=unused-imports", arg "-Wwarn=unused-top-binds"] + -- Darwin has marked sem_getvalue as deprecated. + , package unix ? arg "-optc-Wno-error=deprecated-declarations" + -- Darwin has marked vfork as deprecated. + , package process ? arg "-optc-Wno-error=deprecated-declarations" ] - ) + ] -- | Build C and Haskell objects with debugging information. enableDebugInfo :: Flavour -> Flavour ===================================== rts/posix/Ticker.c ===================================== @@ -71,7 +71,7 @@ * For older version of linux/netbsd without timerfd we fall back to the * pthread based implementation. */ -#if HAVE_SYS_TIMERFD_H +#if defined(HAVE_SYS_TIMERFD_H) #define USE_TIMERFD_FOR_ITIMER #endif ===================================== rts/posix/ticker/Pthread.c ===================================== @@ -43,7 +43,7 @@ #include "Proftimer.h" #include "Schedule.h" #include "posix/Clock.h" -#include +#include #include #if HAVE_SYS_TIME_H ===================================== rts/posix/ticker/TimerFd.c ===================================== @@ -43,7 +43,7 @@ #include "Proftimer.h" #include "Schedule.h" #include "posix/Clock.h" -#include +#include #include #if HAVE_SYS_TIME_H ===================================== rts/sm/NonMovingMark.c ===================================== @@ -27,8 +27,10 @@ #include "sm/Storage.h" #include "CNF.h" +#if defined(THREADED_RTS) static void nonmovingResetUpdRemSetQueue (MarkQueue *rset); static void nonmovingResetUpdRemSet (UpdRemSet *rset); +#endif static bool check_in_nonmoving_heap(StgClosure *p); static void mark_closure (MarkQueue *queue, const StgClosure *p, StgClosure **origin); static void trace_tso (MarkQueue *queue, StgTSO *tso); @@ -940,6 +942,7 @@ void nonmovingInitUpdRemSet (UpdRemSet *rset) rset->queue.is_upd_rem_set = true; } +#if defined(THREADED_RTS) static void nonmovingResetUpdRemSetQueue (MarkQueue *rset) { // UpdRemSets always have one block for the mark queue. This assertion is to @@ -949,10 +952,11 @@ static void nonmovingResetUpdRemSetQueue (MarkQueue *rset) rset->top->head = 0; } -void nonmovingResetUpdRemSet (UpdRemSet *rset) +static void nonmovingResetUpdRemSet (UpdRemSet *rset) { nonmovingResetUpdRemSetQueue(&rset->queue); } +#endif void freeMarkQueue (MarkQueue *queue) { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ef6fb93654a424edc943076163f2e6d279f19dd9...e63d0cb85962f006989ab0902b9b5b38ee9a47f7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ef6fb93654a424edc943076163f2e6d279f19dd9...e63d0cb85962f006989ab0902b9b5b38ee9a47f7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 19:41:03 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 08 Feb 2023 14:41:03 -0500 Subject: [Git][ghc/ghc][master] Fix tyvar scoping within class SPECIALISE pragmas Message-ID: <63e3facf68e83_2b039a5274c76893@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 3 changed files: - compiler/GHC/Rename/Bind.hs - + testsuite/tests/rename/should_compile/T22913.hs - testsuite/tests/rename/should_compile/all.T Changes: ===================================== compiler/GHC/Rename/Bind.hs ===================================== @@ -893,17 +893,15 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs -- Rename the pragmas and signatures -- Annoyingly the type variables /are/ in scope for signatures, but - -- /are not/ in scope in the SPECIALISE instance pramas; e.g. - -- instance Eq a => Eq (T a) where - -- (==) :: a -> a -> a - -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-} - ; let (spec_inst_prags, other_sigs) = partition isSpecInstLSig sigs + -- /are not/ in scope in SPECIALISE and SPECIALISE instance pragmas. + -- See Note [Type variable scoping in SPECIALISE pragmas]. + ; let (spec_prags, other_sigs) = partition (isSpecLSig <||> isSpecInstLSig) sigs bound_nms = mkNameSet (collectHsBindsBinders CollNoDictBinders binds') sig_ctxt | is_cls_decl = ClsDeclCtxt cls | otherwise = InstDeclCtxt bound_nms - ; (spec_inst_prags', sip_fvs) <- renameSigs sig_ctxt spec_inst_prags - ; (other_sigs', sig_fvs) <- bindLocalNamesFV ktv_names $ - renameSigs sig_ctxt other_sigs + ; (spec_prags', spg_fvs) <- renameSigs sig_ctxt spec_prags + ; (other_sigs', sig_fvs) <- bindLocalNamesFV ktv_names $ + renameSigs sig_ctxt other_sigs -- Rename the bindings RHSs. Again there's an issue about whether the -- type variables from the class/instance head are in scope. @@ -914,8 +912,47 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs emptyFVs binds_w_dus ; return (mapBag fstOf3 binds_w_dus, bind_fvs) } - ; return ( binds'', spec_inst_prags' ++ other_sigs' - , sig_fvs `plusFV` sip_fvs `plusFV` bind_fvs) } + ; return ( binds'', spec_prags' ++ other_sigs' + , sig_fvs `plusFV` spg_fvs `plusFV` bind_fvs) } + +{- Note [Type variable scoping in SPECIALISE pragmas] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When renaming the methods of a class or instance declaration, we must be careful +with the scoping of the type variables that occur in SPECIALISE and SPECIALISE instance +pragmas: the type variables from the class/instance header DO NOT scope over these, +unlike class/instance method type signatures. + +Examples: + + 1. SPECIALISE + + class C a where + meth :: a + instance C (Maybe a) where + meth = Nothing + {-# SPECIALISE INLINE meth :: Maybe [a] #-} + + 2. SPECIALISE instance + + instance Eq a => Eq (T a) where + (==) :: a -> a -> a + {-# SPECIALISE instance Eq a => Eq (T [a]) #-} + + In both cases, the type variable `a` mentioned in the PRAGMA is NOT the same + as the type variable `a` from the instance header. + For example, the SPECIALISE instance pragma above is a shorthand for + + {-# SPECIALISE instance forall a. Eq a => Eq (T [a]) #-} + + which is alpha-equivalent to + + {-# SPECIALISE instance forall b. Eq b => Eq (T [b]) #-} + + This shows that the type variables are not bound in the header. + + Getting this scoping wrong can lead to out-of-scope type variable errors from + Core Lint, see e.g. #22913. +-} rnMethodBindLHS :: Bool -> Name -> LHsBindLR GhcPs GhcPs ===================================== testsuite/tests/rename/should_compile/T22913.hs ===================================== @@ -0,0 +1,10 @@ +module T22913 where + +class FromSourceIO a where + fromSourceIO :: a +instance FromSourceIO (Maybe o) where + fromSourceIO = undefined + {-# SPECIALISE INLINE fromSourceIO :: Maybe o #-} + -- This SPECIALISE pragma caused a Core Lint error + -- due to incorrectly scoping the type variable 'o' from the instance header + -- over the SPECIALISE pragma. ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -199,3 +199,4 @@ test('T22513f', normal, compile, ['-Wterm-variable-capture']) test('T22513g', normal, compile, ['-Wterm-variable-capture']) test('T22513h', normal, compile, ['-Wterm-variable-capture']) test('T22513i', req_th, compile, ['-Wterm-variable-capture']) +test('T22913', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9ee761bf02cdd11c955454a222c85971d95dce11 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9ee761bf02cdd11c955454a222c85971d95dce11 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 19:41:38 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 08 Feb 2023 14:41:38 -0500 Subject: [Git][ghc/ghc][master] Revert "Don't keep exit join points so much" Message-ID: <63e3faf2a6b95_2b039a5274c80256@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 11 changed files: - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - − testsuite/tests/simplCore/should_compile/T21148.hs - − testsuite/tests/simplCore/should_compile/T21148.stderr - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/stranal/should_compile/T21128.hs - testsuite/tests/stranal/should_compile/T21128.stderr Changes: ===================================== compiler/GHC/Core/Opt/Exitify.hs ===================================== @@ -433,7 +433,6 @@ inlining. Exit join points, recognizable using `isExitJoinId` are join points with an occurrence in a recursive group, and can be recognized (after the occurrence analyzer ran!) using `isExitJoinId`. - This function detects joinpoints with `occ_in_lam (idOccinfo id) == True`, because the lambdas of a non-recursive join point are not considered for `occ_in_lam`. For example, in the following code, `j1` is /not/ marked @@ -447,29 +446,6 @@ To prevent inlining, we check for isExitJoinId * In `simplLetUnfolding` we simply give exit join points no unfolding, which prevents inlining in `postInlineUnconditionally` and call sites. -But see Note [Be selective about not-inlining exit join points] - -Note [Be selective about not-inlining exit join points] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If we follow "do not inline exit join points" mantra throughout, -some bad things happen. - -* We can lose CPR information: see #21148 - -* We get useless clutter (#22084) that - - makes the program bigger (including duplicated code #20739), and - - adds extra jumps (and maybe stack saves) at runtime - -So instead we follow "do not inline exit join points" for a /single run/ -of the simplifier, right after Exitification. That should give a -sufficient chance for used-once things to inline, but subsequent runs -will inline them back in. (Annoyingly, as things stand, only with -O2 -is there a subsequent run, but that might change, and it's not a huge -deal anyway.) - -This is controlled by the Simplifier's sm_keep_exits flag; see -GHC.Core.Opt.Pipeline. - Note [Placement of the exitification pass] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ I (Joachim) experimented with multiple positions for the Exitification pass in ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -15,7 +15,7 @@ import GHC.Driver.Plugins ( withPlugins, installCoreToDos ) import GHC.Driver.Env import GHC.Driver.Config.Core.Lint ( endPass ) import GHC.Driver.Config.Core.Opt.LiberateCase ( initLiberateCaseOpts ) -import GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyOpts, initSimplMode ) +import GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyOpts, initSimplMode, initGentleSimplMode ) import GHC.Driver.Config.Core.Opt.WorkWrap ( initWorkWrapOpts ) import GHC.Driver.Config.Core.Rules ( initRuleOpts ) import GHC.Platform.Ways ( hasWay, Way(WayProf) ) @@ -28,7 +28,6 @@ import GHC.Core.Utils ( dumpIdInfoOfProgram ) import GHC.Core.Lint ( lintAnnots ) import GHC.Core.Lint.Interactive ( interactiveInScope ) import GHC.Core.Opt.Simplify ( simplifyExpr, simplifyPgm ) -import GHC.Core.Opt.Simplify.Env( SimplMode(..) ) import GHC.Core.Opt.Simplify.Monad import GHC.Core.Opt.Monad import GHC.Core.Opt.Pipeline.Types @@ -153,45 +152,32 @@ getCoreToDo dflags hpt_rule_base extra_vars maybe_strictness_before _ = CoreDoNothing - ---------------------------- - base_simpl_mode :: SimplMode - base_simpl_mode = initSimplMode dflags - - -- gentle_mode: make specialiser happy: minimum effort please - -- See Note [Inline in InitialPhase] - -- See Note [RULEs enabled in InitialPhase] - gentle_mode = base_simpl_mode { sm_names = ["Gentle"] - , sm_phase = InitialPhase - , sm_case_case = False } - - simpl_mode phase name - = base_simpl_mode { sm_names = [name], sm_phase = phase } - - keep_exits :: SimplMode -> SimplMode - -- See Note [Be selective about not-inlining exit join points] - -- in GHC.Core.Opt.Exitify - keep_exits mode = mode { sm_keep_exits = True } - - ---------------------------- - run_simplifier mode iter - = CoreDoSimplify $ initSimplifyOpts dflags extra_vars iter mode hpt_rule_base - - simpl_phase phase name iter = CoreDoPasses $ - [ maybe_strictness_before phase - , run_simplifier (simpl_mode phase name) iter - , maybe_rule_check phase ] + simpl_phase phase name iter + = CoreDoPasses + $ [ maybe_strictness_before phase + , CoreDoSimplify $ initSimplifyOpts dflags extra_vars iter + (initSimplMode dflags phase name) hpt_rule_base + , maybe_rule_check phase ] -- Run GHC's internal simplification phase, after all rules have run. -- See Note [Compiler phases] in GHC.Types.Basic - simpl_gently = run_simplifier gentle_mode max_iter - simplify_final name = run_simplifier ( simpl_mode FinalPhase name) max_iter - simpl_keep_exits name = run_simplifier (keep_exits $ simpl_mode FinalPhase name) max_iter + simplify name = simpl_phase FinalPhase name max_iter + + -- initial simplify: mk specialiser happy: minimum effort please + -- See Note [Inline in InitialPhase] + -- See Note [RULEs enabled in InitialPhase] + simpl_gently = CoreDoSimplify $ initSimplifyOpts dflags extra_vars max_iter + (initGentleSimplMode dflags) hpt_rule_base - ---------------------------- dmd_cpr_ww = if ww_on then [CoreDoDemand True,CoreDoCpr,CoreDoWorkerWrapper] else [CoreDoDemand False] -- NB: No CPR! See Note [Don't change boxity without worker/wrapper] + demand_analyser = (CoreDoPasses ( + dmd_cpr_ww ++ + [simplify "post-worker-wrapper"] + )) + -- Static forms are moved to the top level with the FloatOut pass. -- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable. static_ptrs_float_outwards = @@ -281,16 +267,14 @@ getCoreToDo dflags hpt_rule_base extra_vars runWhen call_arity $ CoreDoPasses [ CoreDoCallArity - , simplify_final "post-call-arity" + , simplify "post-call-arity" ], -- Strictness analysis - runWhen strictness $ CoreDoPasses - (dmd_cpr_ww ++ [simplify_final "post-worker-wrapper"]), + runWhen strictness demand_analyser, runWhen exitification CoreDoExitify, -- See Note [Placement of the exitification pass] - -- in GHC.Core.Opt.Exitify runWhen full_laziness $ CoreDoFloatOutwards FloatOutSwitches { @@ -312,17 +296,7 @@ getCoreToDo dflags hpt_rule_base extra_vars runWhen do_float_in CoreDoFloatInwards, - -- Final tidy-up run of the simplifier - simpl_keep_exits "final tidy up", - -- Keep exit join point because this is the first - -- Simplifier run after Exitify. Subsequent runs will - -- re-inline those exit join points; their work is done. - -- See Note [Be selective about not-inlining exit join points] - -- in GHC.Core.Opt.Exitify - -- - -- Annoyingly, we only /have/ a subsequent run with -O2. With - -- plain -O we'll still have those exit join points hanging around. - -- Oh well. + simplify "final", -- Final tidy-up maybe_rule_check FinalPhase, @@ -332,31 +306,31 @@ getCoreToDo dflags hpt_rule_base extra_vars -- Case-liberation for -O2. This should be after -- strictness analysis and the simplification which follows it. runWhen liberate_case $ CoreDoPasses - [ CoreLiberateCase, simplify_final "post-liberate-case" ], + [ CoreLiberateCase, simplify "post-liberate-case" ], -- Run the simplifier after LiberateCase to vastly -- reduce the possibility of shadowing -- Reason: see Note [Shadowing] in GHC.Core.Opt.SpecConstr runWhen spec_constr $ CoreDoPasses - [ CoreDoSpecConstr, simplify_final "post-spec-constr"], + [ CoreDoSpecConstr, simplify "post-spec-constr"], -- See Note [Simplify after SpecConstr] maybe_rule_check FinalPhase, runWhen late_specialise $ CoreDoPasses - [ CoreDoSpecialising, simplify_final "post-late-spec"], + [ CoreDoSpecialising, simplify "post-late-spec"], -- LiberateCase can yield new CSE opportunities because it peels -- off one layer of a recursive function (concretely, I saw this -- in wheel-sieve1), and I'm guessing that SpecConstr can too -- And CSE is a very cheap pass. So it seems worth doing here. runWhen ((liberate_case || spec_constr) && cse) $ CoreDoPasses - [ CoreCSE, simplify_final "post-final-cse" ], + [ CoreCSE, simplify "post-final-cse" ], --------- End of -O2 passes -------------- runWhen late_dmd_anal $ CoreDoPasses ( - dmd_cpr_ww ++ [simplify_final "post-late-ww"] + dmd_cpr_ww ++ [simplify "post-late-ww"] ), -- Final run of the demand_analyser, ensures that one-shot thunks are ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -248,16 +248,13 @@ data SimplMode = SimplMode -- See comments in GHC.Core.Opt.Simplify.Monad , sm_uf_opts :: !UnfoldingOpts -- ^ Unfolding options , sm_case_case :: !Bool -- ^ Whether case-of-case is enabled , sm_pre_inline :: !Bool -- ^ Whether pre-inlining is enabled - , sm_keep_exits :: !Bool -- ^ True <=> keep ExitJoinIds - -- See Note [Do not inline exit join points] - -- in GHC.Core.Opt.Exitify - , sm_float_enable :: !FloatEnable -- ^ Whether to enable floating out + , sm_float_enable :: !FloatEnable -- ^ Whether to enable floating out , sm_do_eta_reduction :: !Bool - , sm_arity_opts :: !ArityOpts - , sm_rule_opts :: !RuleOpts - , sm_case_folding :: !Bool - , sm_case_merge :: !Bool - , sm_co_opt_opts :: !OptCoercionOpts -- ^ Coercion optimiser options + , sm_arity_opts :: !ArityOpts + , sm_rule_opts :: !RuleOpts + , sm_case_folding :: !Bool + , sm_case_merge :: !Bool + , sm_co_opt_opts :: !OptCoercionOpts -- ^ Coercion optimiser options } instance Outputable SimplMode where ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1395,11 +1395,11 @@ preInlineUnconditionally -- Reason: we don't want to inline single uses, or discard dead bindings, -- for unlifted, side-effect-ful bindings preInlineUnconditionally env top_lvl bndr rhs rhs_env - | not pre_inline = Nothing + | not pre_inline_unconditionally = Nothing | not active = Nothing | isTopLevel top_lvl && isDeadEndId bndr = Nothing -- Note [Top-level bottoming Ids] | isCoVar bndr = Nothing -- Note [Do not inline CoVars unconditionally] - | keep_exits, isExitJoinId bndr = Nothing -- Note [Do not inline exit join points] + | isExitJoinId bndr = Nothing -- Note [Do not inline exit join points] -- in module Exitify | not (one_occ (idOccInfo bndr)) = Nothing | not (isStableUnfolding unf) = Just $! (extend_subst_with rhs) @@ -1409,36 +1409,19 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env , Just inl <- maybeUnfoldingTemplate unf = Just $! (extend_subst_with inl) | otherwise = Nothing where - mode = seMode env - phase = sm_phase mode - keep_exits = sm_keep_exits mode - pre_inline = sm_pre_inline mode - unf = idUnfolding bndr extend_subst_with inl_rhs = extendIdSubst env bndr $! (mkContEx rhs_env inl_rhs) one_occ IAmDead = True -- Happens in ((\x.1) v) - one_occ OneOcc{ occ_n_br = 1 , occ_in_lam = NotInsideLam } = isNotTopLevel top_lvl || early_phase - one_occ OneOcc{ occ_n_br = 1 , occ_in_lam = IsInsideLam , occ_int_cxt = IsInteresting } = canInlineInLam rhs + one_occ _ = False - one_occ OneOcc{ occ_n_br = 1 } -- Inline join point that are used once, even inside - | isJoinId bndr = True -- lambdas (which are presumably other join points) - -- E.g. join j x = rhs in - -- joinrec k y = ....j x.... - -- Here j must be an exit for k, and we can safely inline it under the lambda - -- This includes the case where j is nullary: a nullary join point is just the - -- same as an arity-1 one. So we don't look at occ_int_cxt. - -- All of this only applies if keep_exits is False, otherwise the - -- earlier guard on preInlineUnconditionally would have fired - - one_occ _ = False - - active = isActive phase (inlinePragmaActivation inline_prag) + pre_inline_unconditionally = sePreInline env + active = isActive (sePhase env) (inlinePragmaActivation inline_prag) -- See Note [pre/postInlineUnconditionally in gentle mode] inline_prag = idInlinePragma bndr @@ -1470,7 +1453,7 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env -- not ticks. Counting ticks cannot be duplicated, and non-counting -- ticks around a Lam will disappear anyway. - early_phase = phase /= FinalPhase + early_phase = sePhase env /= FinalPhase -- If we don't have this early_phase test, consider -- x = length [1,2,3] -- The full laziness pass carefully floats all the cons cells to ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -1532,10 +1532,8 @@ scExpr' env (Case scrut b ty alts) scrut_occ = case con of DataAlt dc -- See Note [Do not specialise evals] | not (single_alt && all deadArgOcc arg_occs) - -> -- pprTrace "sc_alt1" (ppr b' $$ ppr con $$ ppr bs $$ ppr arg_occs) $ - ScrutOcc (unitUFM dc arg_occs) - _ -> -- pprTrace "sc_alt1" (ppr b' $$ ppr con $$ ppr bs $$ ppr arg_occs) $ - UnkOcc + -> ScrutOcc (unitUFM dc arg_occs) + _ -> UnkOcc ; return (usg', b_occ `combineOcc` scrut_occ, Alt con bs2 rhs') } ===================================== compiler/GHC/Driver/Config/Core/Opt/Simplify.hs ===================================== @@ -2,6 +2,7 @@ module GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyExprOpts , initSimplifyOpts , initSimplMode + , initGentleSimplMode ) where import GHC.Prelude @@ -26,13 +27,12 @@ import GHC.Types.Var ( Var ) initSimplifyExprOpts :: DynFlags -> InteractiveContext -> SimplifyExprOpts initSimplifyExprOpts dflags ic = SimplifyExprOpts { se_fam_inst = snd $ ic_instances ic - - , se_mode = (initSimplMode dflags) { sm_names = ["GHCi"] - , sm_inline = False } - -- sm_inline: do not do any inlining, in case we expose - -- some unboxed tuple stuff that confuses the bytecode + , se_mode = (initSimplMode dflags InitialPhase "GHCi") + { sm_inline = False + -- Do not do any inlining, in case we expose some + -- unboxed tuple stuff that confuses the bytecode -- interpreter - + } , se_top_env_cfg = TopEnvConfig { te_history_size = historySize dflags , te_tick_factor = simplTickFactor dflags @@ -56,25 +56,31 @@ initSimplifyOpts dflags extra_vars iterations mode hpt_rule_base = let } in opts -initSimplMode :: DynFlags -> SimplMode -initSimplMode dflags = SimplMode - { sm_names = ["Unknown simplifier run"] -- Always overriden - , sm_phase = InitialPhase - , sm_rules = gopt Opt_EnableRewriteRules dflags - , sm_eta_expand = gopt Opt_DoLambdaEtaExpansion dflags - , sm_pre_inline = gopt Opt_SimplPreInlining dflags - , sm_do_eta_reduction = gopt Opt_DoEtaReduction dflags - , sm_uf_opts = unfoldingOpts dflags - , sm_float_enable = floatEnable dflags - , sm_arity_opts = initArityOpts dflags - , sm_rule_opts = initRuleOpts dflags - , sm_case_folding = gopt Opt_CaseFolding dflags - , sm_case_merge = gopt Opt_CaseMerge dflags - , sm_co_opt_opts = initOptCoercionOpts dflags +initSimplMode :: DynFlags -> CompilerPhase -> String -> SimplMode +initSimplMode dflags phase name = SimplMode + { sm_names = [name] + , sm_phase = phase + , sm_rules = gopt Opt_EnableRewriteRules dflags + , sm_eta_expand = gopt Opt_DoLambdaEtaExpansion dflags , sm_cast_swizzle = True - , sm_inline = True - , sm_case_case = True - , sm_keep_exits = False + , sm_inline = True + , sm_uf_opts = unfoldingOpts dflags + , sm_case_case = True + , sm_pre_inline = gopt Opt_SimplPreInlining dflags + , sm_float_enable = floatEnable dflags + , sm_do_eta_reduction = gopt Opt_DoEtaReduction dflags + , sm_arity_opts = initArityOpts dflags + , sm_rule_opts = initRuleOpts dflags + , sm_case_folding = gopt Opt_CaseFolding dflags + , sm_case_merge = gopt Opt_CaseMerge dflags + , sm_co_opt_opts = initOptCoercionOpts dflags + } + +initGentleSimplMode :: DynFlags -> SimplMode +initGentleSimplMode dflags = (initSimplMode dflags InitialPhase "Gentle") + { -- Don't do case-of-case transformations. + -- This makes full laziness work better + sm_case_case = False } floatEnable :: DynFlags -> FloatEnable ===================================== testsuite/tests/simplCore/should_compile/T21148.hs deleted ===================================== @@ -1,12 +0,0 @@ -module T211148 where - --- The point of this test is that f should get a (nested) --- CPR property, with a worker of type --- $wf :: Int# -> State# RealWorld -> (# State# RealWorld, Int# #) - -{-# NOINLINE f #-} --- The NOINLINE makes GHC do a worker/wrapper split --- even though f is small -f :: Int -> IO Int -f x = return $! sum [0..x] - ===================================== testsuite/tests/simplCore/should_compile/T21148.stderr deleted ===================================== @@ -1,126 +0,0 @@ - -==================== Tidy Core ==================== -Result size of Tidy Core - = {terms: 73, types: 80, coercions: 6, joins: 2/2} - --- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule4 :: GHC.Prim.Addr# -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] -T211148.$trModule4 = "main"# - --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule3 :: GHC.Types.TrName -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -T211148.$trModule3 = GHC.Types.TrNameS T211148.$trModule4 - --- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule2 :: GHC.Prim.Addr# -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] -T211148.$trModule2 = "T211148"# - --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule1 :: GHC.Types.TrName -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -T211148.$trModule1 = GHC.Types.TrNameS T211148.$trModule2 - --- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule :: GHC.Types.Module -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -T211148.$trModule - = GHC.Types.Module T211148.$trModule3 T211148.$trModule1 - --- RHS size: {terms: 41, types: 35, coercions: 0, joins: 2/2} -T211148.$wf [InlPrag=NOINLINE] - :: GHC.Prim.Int# - -> GHC.Prim.State# GHC.Prim.RealWorld - -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #) -[GblId, Arity=2, Str=, Unf=OtherCon []] -T211148.$wf - = \ (ww_s179 :: GHC.Prim.Int#) - (eta_s17b [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld) -> - case GHC.Prim.># 0# ww_s179 of { - __DEFAULT -> - join { - exit_X0 [Dmd=SC(S,C(1,!P(L,L)))] - :: GHC.Prim.Int# - -> GHC.Prim.Int# - -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #) - [LclId[JoinId(2)(Nothing)], Arity=2, Str=] - exit_X0 (x_s16Z [OS=OneShot] :: GHC.Prim.Int#) - (ww1_s172 [OS=OneShot] :: GHC.Prim.Int#) - = (# eta_s17b, GHC.Prim.+# ww1_s172 x_s16Z #) } in - joinrec { - $wgo3_s175 [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,C(1,!P(L,L)))] - :: GHC.Prim.Int# - -> GHC.Prim.Int# - -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #) - [LclId[JoinId(2)(Nothing)], Arity=2, Str=, Unf=OtherCon []] - $wgo3_s175 (x_s16Z :: GHC.Prim.Int#) (ww1_s172 :: GHC.Prim.Int#) - = case GHC.Prim.==# x_s16Z ww_s179 of { - __DEFAULT -> - jump $wgo3_s175 - (GHC.Prim.+# x_s16Z 1#) (GHC.Prim.+# ww1_s172 x_s16Z); - 1# -> jump exit_X0 x_s16Z ww1_s172 - }; } in - jump $wgo3_s175 0# 0#; - 1# -> (# eta_s17b, 0# #) - } - --- RHS size: {terms: 14, types: 19, coercions: 0, joins: 0/0} -T211148.f1 [InlPrag=NOINLINE[final]] - :: Int - -> GHC.Prim.State# GHC.Prim.RealWorld - -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #) -[GblId, - Arity=2, - Str=<1!P(L)>, - Cpr=1(, 1), - Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (x_s177 [Occ=Once1!] :: Int) - (eta_s17b [Occ=Once1, OS=OneShot] - :: GHC.Prim.State# GHC.Prim.RealWorld) -> - case x_s177 of { GHC.Types.I# ww_s179 [Occ=Once1] -> - case T211148.$wf ww_s179 eta_s17b of - { (# ww1_s17e [Occ=Once1], ww2_s17j [Occ=Once1] #) -> - (# ww1_s17e, GHC.Types.I# ww2_s17j #) - } - }}] -T211148.f1 - = \ (x_s177 :: Int) - (eta_s17b [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld) -> - case x_s177 of { GHC.Types.I# ww_s179 -> - case T211148.$wf ww_s179 eta_s17b of { (# ww1_s17e, ww2_s17j #) -> - (# ww1_s17e, GHC.Types.I# ww2_s17j #) - } - } - --- RHS size: {terms: 1, types: 0, coercions: 6, joins: 0/0} -f [InlPrag=NOINLINE[final]] :: Int -> IO Int -[GblId, - Arity=2, - Str=<1!P(L)>, - Cpr=1(, 1), - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}] -f = T211148.f1 - `cast` (_R %<'Many>_N ->_R Sym (GHC.Types.N:IO[0] _R) - :: (Int - -> GHC.Prim.State# GHC.Prim.RealWorld - -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)) - ~R# (Int -> IO Int)) - - - ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -429,7 +429,6 @@ test('T21763a', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) test('T22028', normal, compile, ['-O -ddump-rule-firings']) test('T22114', normal, compile, ['-O']) test('T21286', normal, multimod_compile, ['T21286', '-O -ddump-rule-firings']) -test('T21148', [grep_errmsg(r'Cpr=') ], compile, ['-O -ddump-simpl']) # One module, T21851.hs, has OPTIONS_GHC -ddump-simpl test('T21851', [grep_errmsg(r'case.*w\$sf') ], multimod_compile, ['T21851', '-O -dno-typeable-binds -dsuppress-uniques']) ===================================== testsuite/tests/stranal/should_compile/T21128.hs ===================================== @@ -2,10 +2,6 @@ module T21128 where import T21128a -{- This test originally had some unnecessary reboxing of y -in the hot path of $wtheresCrud. That reboxing should -not happen. -} - theresCrud :: Int -> Int -> Int theresCrud x y = go x where @@ -13,4 +9,3 @@ theresCrud x y = go x go 1 = index x y 1 go n = go (n-1) {-# NOINLINE theresCrud #-} - ===================================== testsuite/tests/stranal/should_compile/T21128.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 125, types: 68, coercions: 4, joins: 0/0} + = {terms: 137, types: 92, coercions: 4, joins: 0/0} lvl = "error"# @@ -29,11 +29,17 @@ lvl9 = SrcLoc lvl2 lvl3 lvl5 lvl6 lvl7 lvl6 lvl8 lvl10 = PushCallStack lvl1 lvl9 EmptyCallStack +$windexError + = \ @a @b ww eta eta1 eta2 -> + error + (lvl10 `cast` :: CallStack ~R# (?callStack::CallStack)) + (++ (ww eta) (++ (ww eta1) (ww eta2))) + indexError = \ @a @b $dShow eta eta1 eta2 -> - error - (lvl10 `cast` :: ...) - (++ (show $dShow eta) (++ (show $dShow eta1) (show $dShow eta2))) + case $dShow of { C:Show ww ww1 ww2 -> + $windexError ww1 eta eta1 eta2 + } $trModule3 = TrNameS $trModule4 @@ -42,7 +48,8 @@ $trModule1 = TrNameS $trModule2 $trModule = Module $trModule3 $trModule1 $wlvl - = \ ww ww1 ww2 -> indexError $fShowInt (I# ww2) (I# ww1) (I# ww) + = \ ww ww1 ww2 -> + $windexError $fShowInt_$cshow (I# ww2) (I# ww1) (I# ww) index = \ l u i -> @@ -66,7 +73,7 @@ index ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 108, types: 46, coercions: 0, joins: 3/3} + = {terms: 108, types: 47, coercions: 0, joins: 3/4} $trModule4 = "main"# @@ -82,34 +89,35 @@ i = I# 1# l = I# 0# -lvl = \ x ww -> indexError $fShowInt x (I# ww) i +lvl = \ y -> $windexError $fShowInt_$cshow l y l -lvl1 = \ ww -> indexError $fShowInt l (I# ww) l +lvl1 = \ ww y -> $windexError $fShowInt_$cshow (I# ww) y i $wtheresCrud = \ ww ww1 -> + let { y = I# ww1 } in join { - exit - = case <# 0# ww1 of { - __DEFAULT -> case lvl1 ww1 of wild { }; - 1# -> 0# - } } in - join { - exit1 + lvl2 = case <=# ww 1# of { - __DEFAULT -> case lvl (I# ww) ww1 of wild { }; + __DEFAULT -> case lvl1 ww y of wild { }; 1# -> case <# 1# ww1 of { - __DEFAULT -> case lvl (I# ww) ww1 of wild { }; + __DEFAULT -> case lvl1 ww y of wild { }; 1# -> -# 1# ww } } } in + join { + lvl3 + = case <# 0# ww1 of { + __DEFAULT -> case lvl y of wild { }; + 1# -> 0# + } } in joinrec { $wgo ww2 = case ww2 of wild { __DEFAULT -> jump $wgo (-# wild 1#); - 0# -> jump exit; - 1# -> jump exit1 + 0# -> jump lvl3; + 1# -> jump lvl2 }; } in jump $wgo ww View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7eac2468a726f217dd97c5e2884f6b552e8ef11d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7eac2468a726f217dd97c5e2884f6b552e8ef11d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 20:42:37 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 08 Feb 2023 15:42:37 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Fix tyvar scoping within class SPECIALISE pragmas Message-ID: <63e4093d8a802_2b039a52670956d2@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - c803e8d7 by Cheng Shao at 2023-02-08T15:42:10-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - 274d24da by Cheng Shao at 2023-02-08T15:42:10-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - d5b5c07c by Alan Zimmerman at 2023-02-08T15:42:10-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - 26 changed files: - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Rename/Bind.hs - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/driver/testutil.py - + testsuite/tests/ghc-api/exactprint/T22919.hs - + testsuite/tests/ghc-api/exactprint/T22919.stderr - testsuite/tests/ghc-api/exactprint/Test20239.stderr - testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr - testsuite/tests/ghc-api/exactprint/all.T - testsuite/tests/parser/should_compile/DumpParsedAstComments.hs - testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr - + testsuite/tests/rename/should_compile/T22913.hs - testsuite/tests/rename/should_compile/all.T - − testsuite/tests/simplCore/should_compile/T21148.hs - − testsuite/tests/simplCore/should_compile/T21148.stderr - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/stranal/should_compile/T21128.hs - testsuite/tests/stranal/should_compile/T21128.stderr Changes: ===================================== compiler/GHC/Core/Opt/Exitify.hs ===================================== @@ -433,7 +433,6 @@ inlining. Exit join points, recognizable using `isExitJoinId` are join points with an occurrence in a recursive group, and can be recognized (after the occurrence analyzer ran!) using `isExitJoinId`. - This function detects joinpoints with `occ_in_lam (idOccinfo id) == True`, because the lambdas of a non-recursive join point are not considered for `occ_in_lam`. For example, in the following code, `j1` is /not/ marked @@ -447,29 +446,6 @@ To prevent inlining, we check for isExitJoinId * In `simplLetUnfolding` we simply give exit join points no unfolding, which prevents inlining in `postInlineUnconditionally` and call sites. -But see Note [Be selective about not-inlining exit join points] - -Note [Be selective about not-inlining exit join points] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If we follow "do not inline exit join points" mantra throughout, -some bad things happen. - -* We can lose CPR information: see #21148 - -* We get useless clutter (#22084) that - - makes the program bigger (including duplicated code #20739), and - - adds extra jumps (and maybe stack saves) at runtime - -So instead we follow "do not inline exit join points" for a /single run/ -of the simplifier, right after Exitification. That should give a -sufficient chance for used-once things to inline, but subsequent runs -will inline them back in. (Annoyingly, as things stand, only with -O2 -is there a subsequent run, but that might change, and it's not a huge -deal anyway.) - -This is controlled by the Simplifier's sm_keep_exits flag; see -GHC.Core.Opt.Pipeline. - Note [Placement of the exitification pass] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ I (Joachim) experimented with multiple positions for the Exitification pass in ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -15,7 +15,7 @@ import GHC.Driver.Plugins ( withPlugins, installCoreToDos ) import GHC.Driver.Env import GHC.Driver.Config.Core.Lint ( endPass ) import GHC.Driver.Config.Core.Opt.LiberateCase ( initLiberateCaseOpts ) -import GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyOpts, initSimplMode ) +import GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyOpts, initSimplMode, initGentleSimplMode ) import GHC.Driver.Config.Core.Opt.WorkWrap ( initWorkWrapOpts ) import GHC.Driver.Config.Core.Rules ( initRuleOpts ) import GHC.Platform.Ways ( hasWay, Way(WayProf) ) @@ -28,7 +28,6 @@ import GHC.Core.Utils ( dumpIdInfoOfProgram ) import GHC.Core.Lint ( lintAnnots ) import GHC.Core.Lint.Interactive ( interactiveInScope ) import GHC.Core.Opt.Simplify ( simplifyExpr, simplifyPgm ) -import GHC.Core.Opt.Simplify.Env( SimplMode(..) ) import GHC.Core.Opt.Simplify.Monad import GHC.Core.Opt.Monad import GHC.Core.Opt.Pipeline.Types @@ -153,45 +152,32 @@ getCoreToDo dflags hpt_rule_base extra_vars maybe_strictness_before _ = CoreDoNothing - ---------------------------- - base_simpl_mode :: SimplMode - base_simpl_mode = initSimplMode dflags - - -- gentle_mode: make specialiser happy: minimum effort please - -- See Note [Inline in InitialPhase] - -- See Note [RULEs enabled in InitialPhase] - gentle_mode = base_simpl_mode { sm_names = ["Gentle"] - , sm_phase = InitialPhase - , sm_case_case = False } - - simpl_mode phase name - = base_simpl_mode { sm_names = [name], sm_phase = phase } - - keep_exits :: SimplMode -> SimplMode - -- See Note [Be selective about not-inlining exit join points] - -- in GHC.Core.Opt.Exitify - keep_exits mode = mode { sm_keep_exits = True } - - ---------------------------- - run_simplifier mode iter - = CoreDoSimplify $ initSimplifyOpts dflags extra_vars iter mode hpt_rule_base - - simpl_phase phase name iter = CoreDoPasses $ - [ maybe_strictness_before phase - , run_simplifier (simpl_mode phase name) iter - , maybe_rule_check phase ] + simpl_phase phase name iter + = CoreDoPasses + $ [ maybe_strictness_before phase + , CoreDoSimplify $ initSimplifyOpts dflags extra_vars iter + (initSimplMode dflags phase name) hpt_rule_base + , maybe_rule_check phase ] -- Run GHC's internal simplification phase, after all rules have run. -- See Note [Compiler phases] in GHC.Types.Basic - simpl_gently = run_simplifier gentle_mode max_iter - simplify_final name = run_simplifier ( simpl_mode FinalPhase name) max_iter - simpl_keep_exits name = run_simplifier (keep_exits $ simpl_mode FinalPhase name) max_iter + simplify name = simpl_phase FinalPhase name max_iter + + -- initial simplify: mk specialiser happy: minimum effort please + -- See Note [Inline in InitialPhase] + -- See Note [RULEs enabled in InitialPhase] + simpl_gently = CoreDoSimplify $ initSimplifyOpts dflags extra_vars max_iter + (initGentleSimplMode dflags) hpt_rule_base - ---------------------------- dmd_cpr_ww = if ww_on then [CoreDoDemand True,CoreDoCpr,CoreDoWorkerWrapper] else [CoreDoDemand False] -- NB: No CPR! See Note [Don't change boxity without worker/wrapper] + demand_analyser = (CoreDoPasses ( + dmd_cpr_ww ++ + [simplify "post-worker-wrapper"] + )) + -- Static forms are moved to the top level with the FloatOut pass. -- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable. static_ptrs_float_outwards = @@ -281,16 +267,14 @@ getCoreToDo dflags hpt_rule_base extra_vars runWhen call_arity $ CoreDoPasses [ CoreDoCallArity - , simplify_final "post-call-arity" + , simplify "post-call-arity" ], -- Strictness analysis - runWhen strictness $ CoreDoPasses - (dmd_cpr_ww ++ [simplify_final "post-worker-wrapper"]), + runWhen strictness demand_analyser, runWhen exitification CoreDoExitify, -- See Note [Placement of the exitification pass] - -- in GHC.Core.Opt.Exitify runWhen full_laziness $ CoreDoFloatOutwards FloatOutSwitches { @@ -312,17 +296,7 @@ getCoreToDo dflags hpt_rule_base extra_vars runWhen do_float_in CoreDoFloatInwards, - -- Final tidy-up run of the simplifier - simpl_keep_exits "final tidy up", - -- Keep exit join point because this is the first - -- Simplifier run after Exitify. Subsequent runs will - -- re-inline those exit join points; their work is done. - -- See Note [Be selective about not-inlining exit join points] - -- in GHC.Core.Opt.Exitify - -- - -- Annoyingly, we only /have/ a subsequent run with -O2. With - -- plain -O we'll still have those exit join points hanging around. - -- Oh well. + simplify "final", -- Final tidy-up maybe_rule_check FinalPhase, @@ -332,31 +306,31 @@ getCoreToDo dflags hpt_rule_base extra_vars -- Case-liberation for -O2. This should be after -- strictness analysis and the simplification which follows it. runWhen liberate_case $ CoreDoPasses - [ CoreLiberateCase, simplify_final "post-liberate-case" ], + [ CoreLiberateCase, simplify "post-liberate-case" ], -- Run the simplifier after LiberateCase to vastly -- reduce the possibility of shadowing -- Reason: see Note [Shadowing] in GHC.Core.Opt.SpecConstr runWhen spec_constr $ CoreDoPasses - [ CoreDoSpecConstr, simplify_final "post-spec-constr"], + [ CoreDoSpecConstr, simplify "post-spec-constr"], -- See Note [Simplify after SpecConstr] maybe_rule_check FinalPhase, runWhen late_specialise $ CoreDoPasses - [ CoreDoSpecialising, simplify_final "post-late-spec"], + [ CoreDoSpecialising, simplify "post-late-spec"], -- LiberateCase can yield new CSE opportunities because it peels -- off one layer of a recursive function (concretely, I saw this -- in wheel-sieve1), and I'm guessing that SpecConstr can too -- And CSE is a very cheap pass. So it seems worth doing here. runWhen ((liberate_case || spec_constr) && cse) $ CoreDoPasses - [ CoreCSE, simplify_final "post-final-cse" ], + [ CoreCSE, simplify "post-final-cse" ], --------- End of -O2 passes -------------- runWhen late_dmd_anal $ CoreDoPasses ( - dmd_cpr_ww ++ [simplify_final "post-late-ww"] + dmd_cpr_ww ++ [simplify "post-late-ww"] ), -- Final run of the demand_analyser, ensures that one-shot thunks are ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -248,16 +248,13 @@ data SimplMode = SimplMode -- See comments in GHC.Core.Opt.Simplify.Monad , sm_uf_opts :: !UnfoldingOpts -- ^ Unfolding options , sm_case_case :: !Bool -- ^ Whether case-of-case is enabled , sm_pre_inline :: !Bool -- ^ Whether pre-inlining is enabled - , sm_keep_exits :: !Bool -- ^ True <=> keep ExitJoinIds - -- See Note [Do not inline exit join points] - -- in GHC.Core.Opt.Exitify - , sm_float_enable :: !FloatEnable -- ^ Whether to enable floating out + , sm_float_enable :: !FloatEnable -- ^ Whether to enable floating out , sm_do_eta_reduction :: !Bool - , sm_arity_opts :: !ArityOpts - , sm_rule_opts :: !RuleOpts - , sm_case_folding :: !Bool - , sm_case_merge :: !Bool - , sm_co_opt_opts :: !OptCoercionOpts -- ^ Coercion optimiser options + , sm_arity_opts :: !ArityOpts + , sm_rule_opts :: !RuleOpts + , sm_case_folding :: !Bool + , sm_case_merge :: !Bool + , sm_co_opt_opts :: !OptCoercionOpts -- ^ Coercion optimiser options } instance Outputable SimplMode where ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1395,11 +1395,11 @@ preInlineUnconditionally -- Reason: we don't want to inline single uses, or discard dead bindings, -- for unlifted, side-effect-ful bindings preInlineUnconditionally env top_lvl bndr rhs rhs_env - | not pre_inline = Nothing + | not pre_inline_unconditionally = Nothing | not active = Nothing | isTopLevel top_lvl && isDeadEndId bndr = Nothing -- Note [Top-level bottoming Ids] | isCoVar bndr = Nothing -- Note [Do not inline CoVars unconditionally] - | keep_exits, isExitJoinId bndr = Nothing -- Note [Do not inline exit join points] + | isExitJoinId bndr = Nothing -- Note [Do not inline exit join points] -- in module Exitify | not (one_occ (idOccInfo bndr)) = Nothing | not (isStableUnfolding unf) = Just $! (extend_subst_with rhs) @@ -1409,36 +1409,19 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env , Just inl <- maybeUnfoldingTemplate unf = Just $! (extend_subst_with inl) | otherwise = Nothing where - mode = seMode env - phase = sm_phase mode - keep_exits = sm_keep_exits mode - pre_inline = sm_pre_inline mode - unf = idUnfolding bndr extend_subst_with inl_rhs = extendIdSubst env bndr $! (mkContEx rhs_env inl_rhs) one_occ IAmDead = True -- Happens in ((\x.1) v) - one_occ OneOcc{ occ_n_br = 1 , occ_in_lam = NotInsideLam } = isNotTopLevel top_lvl || early_phase - one_occ OneOcc{ occ_n_br = 1 , occ_in_lam = IsInsideLam , occ_int_cxt = IsInteresting } = canInlineInLam rhs + one_occ _ = False - one_occ OneOcc{ occ_n_br = 1 } -- Inline join point that are used once, even inside - | isJoinId bndr = True -- lambdas (which are presumably other join points) - -- E.g. join j x = rhs in - -- joinrec k y = ....j x.... - -- Here j must be an exit for k, and we can safely inline it under the lambda - -- This includes the case where j is nullary: a nullary join point is just the - -- same as an arity-1 one. So we don't look at occ_int_cxt. - -- All of this only applies if keep_exits is False, otherwise the - -- earlier guard on preInlineUnconditionally would have fired - - one_occ _ = False - - active = isActive phase (inlinePragmaActivation inline_prag) + pre_inline_unconditionally = sePreInline env + active = isActive (sePhase env) (inlinePragmaActivation inline_prag) -- See Note [pre/postInlineUnconditionally in gentle mode] inline_prag = idInlinePragma bndr @@ -1470,7 +1453,7 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env -- not ticks. Counting ticks cannot be duplicated, and non-counting -- ticks around a Lam will disappear anyway. - early_phase = phase /= FinalPhase + early_phase = sePhase env /= FinalPhase -- If we don't have this early_phase test, consider -- x = length [1,2,3] -- The full laziness pass carefully floats all the cons cells to ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -1532,10 +1532,8 @@ scExpr' env (Case scrut b ty alts) scrut_occ = case con of DataAlt dc -- See Note [Do not specialise evals] | not (single_alt && all deadArgOcc arg_occs) - -> -- pprTrace "sc_alt1" (ppr b' $$ ppr con $$ ppr bs $$ ppr arg_occs) $ - ScrutOcc (unitUFM dc arg_occs) - _ -> -- pprTrace "sc_alt1" (ppr b' $$ ppr con $$ ppr bs $$ ppr arg_occs) $ - UnkOcc + -> ScrutOcc (unitUFM dc arg_occs) + _ -> UnkOcc ; return (usg', b_occ `combineOcc` scrut_occ, Alt con bs2 rhs') } ===================================== compiler/GHC/Driver/Config/Core/Opt/Simplify.hs ===================================== @@ -2,6 +2,7 @@ module GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyExprOpts , initSimplifyOpts , initSimplMode + , initGentleSimplMode ) where import GHC.Prelude @@ -26,13 +27,12 @@ import GHC.Types.Var ( Var ) initSimplifyExprOpts :: DynFlags -> InteractiveContext -> SimplifyExprOpts initSimplifyExprOpts dflags ic = SimplifyExprOpts { se_fam_inst = snd $ ic_instances ic - - , se_mode = (initSimplMode dflags) { sm_names = ["GHCi"] - , sm_inline = False } - -- sm_inline: do not do any inlining, in case we expose - -- some unboxed tuple stuff that confuses the bytecode + , se_mode = (initSimplMode dflags InitialPhase "GHCi") + { sm_inline = False + -- Do not do any inlining, in case we expose some + -- unboxed tuple stuff that confuses the bytecode -- interpreter - + } , se_top_env_cfg = TopEnvConfig { te_history_size = historySize dflags , te_tick_factor = simplTickFactor dflags @@ -56,25 +56,31 @@ initSimplifyOpts dflags extra_vars iterations mode hpt_rule_base = let } in opts -initSimplMode :: DynFlags -> SimplMode -initSimplMode dflags = SimplMode - { sm_names = ["Unknown simplifier run"] -- Always overriden - , sm_phase = InitialPhase - , sm_rules = gopt Opt_EnableRewriteRules dflags - , sm_eta_expand = gopt Opt_DoLambdaEtaExpansion dflags - , sm_pre_inline = gopt Opt_SimplPreInlining dflags - , sm_do_eta_reduction = gopt Opt_DoEtaReduction dflags - , sm_uf_opts = unfoldingOpts dflags - , sm_float_enable = floatEnable dflags - , sm_arity_opts = initArityOpts dflags - , sm_rule_opts = initRuleOpts dflags - , sm_case_folding = gopt Opt_CaseFolding dflags - , sm_case_merge = gopt Opt_CaseMerge dflags - , sm_co_opt_opts = initOptCoercionOpts dflags +initSimplMode :: DynFlags -> CompilerPhase -> String -> SimplMode +initSimplMode dflags phase name = SimplMode + { sm_names = [name] + , sm_phase = phase + , sm_rules = gopt Opt_EnableRewriteRules dflags + , sm_eta_expand = gopt Opt_DoLambdaEtaExpansion dflags , sm_cast_swizzle = True - , sm_inline = True - , sm_case_case = True - , sm_keep_exits = False + , sm_inline = True + , sm_uf_opts = unfoldingOpts dflags + , sm_case_case = True + , sm_pre_inline = gopt Opt_SimplPreInlining dflags + , sm_float_enable = floatEnable dflags + , sm_do_eta_reduction = gopt Opt_DoEtaReduction dflags + , sm_arity_opts = initArityOpts dflags + , sm_rule_opts = initRuleOpts dflags + , sm_case_folding = gopt Opt_CaseFolding dflags + , sm_case_merge = gopt Opt_CaseMerge dflags + , sm_co_opt_opts = initOptCoercionOpts dflags + } + +initGentleSimplMode :: DynFlags -> SimplMode +initGentleSimplMode dflags = (initSimplMode dflags InitialPhase "Gentle") + { -- Don't do case-of-case transformations. + -- This makes full laziness work better + sm_case_case = False } floatEnable :: DynFlags -> FloatEnable ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -3700,11 +3700,13 @@ allocatePriorComments ss comment_q mheader_comments = cmp (L l _) = anchor l <= ss (newAnns,after) = partition cmp comment_q comment_q'= after - (prior_comments, decl_comments) = splitPriorComments ss newAnns + (prior_comments, decl_comments) + = case mheader_comments of + Strict.Nothing -> (reverse newAnns, []) + _ -> splitPriorComments ss newAnns in case mheader_comments of Strict.Nothing -> (Strict.Just prior_comments, comment_q', decl_comments) - -- Strict.Nothing -> (Strict.Just [], comment_q', newAnns) Strict.Just _ -> (mheader_comments, comment_q', reverse newAnns) allocateFinalComments ===================================== compiler/GHC/Rename/Bind.hs ===================================== @@ -893,17 +893,15 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs -- Rename the pragmas and signatures -- Annoyingly the type variables /are/ in scope for signatures, but - -- /are not/ in scope in the SPECIALISE instance pramas; e.g. - -- instance Eq a => Eq (T a) where - -- (==) :: a -> a -> a - -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-} - ; let (spec_inst_prags, other_sigs) = partition isSpecInstLSig sigs + -- /are not/ in scope in SPECIALISE and SPECIALISE instance pragmas. + -- See Note [Type variable scoping in SPECIALISE pragmas]. + ; let (spec_prags, other_sigs) = partition (isSpecLSig <||> isSpecInstLSig) sigs bound_nms = mkNameSet (collectHsBindsBinders CollNoDictBinders binds') sig_ctxt | is_cls_decl = ClsDeclCtxt cls | otherwise = InstDeclCtxt bound_nms - ; (spec_inst_prags', sip_fvs) <- renameSigs sig_ctxt spec_inst_prags - ; (other_sigs', sig_fvs) <- bindLocalNamesFV ktv_names $ - renameSigs sig_ctxt other_sigs + ; (spec_prags', spg_fvs) <- renameSigs sig_ctxt spec_prags + ; (other_sigs', sig_fvs) <- bindLocalNamesFV ktv_names $ + renameSigs sig_ctxt other_sigs -- Rename the bindings RHSs. Again there's an issue about whether the -- type variables from the class/instance head are in scope. @@ -914,8 +912,47 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs emptyFVs binds_w_dus ; return (mapBag fstOf3 binds_w_dus, bind_fvs) } - ; return ( binds'', spec_inst_prags' ++ other_sigs' - , sig_fvs `plusFV` sip_fvs `plusFV` bind_fvs) } + ; return ( binds'', spec_prags' ++ other_sigs' + , sig_fvs `plusFV` spg_fvs `plusFV` bind_fvs) } + +{- Note [Type variable scoping in SPECIALISE pragmas] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When renaming the methods of a class or instance declaration, we must be careful +with the scoping of the type variables that occur in SPECIALISE and SPECIALISE instance +pragmas: the type variables from the class/instance header DO NOT scope over these, +unlike class/instance method type signatures. + +Examples: + + 1. SPECIALISE + + class C a where + meth :: a + instance C (Maybe a) where + meth = Nothing + {-# SPECIALISE INLINE meth :: Maybe [a] #-} + + 2. SPECIALISE instance + + instance Eq a => Eq (T a) where + (==) :: a -> a -> a + {-# SPECIALISE instance Eq a => Eq (T [a]) #-} + + In both cases, the type variable `a` mentioned in the PRAGMA is NOT the same + as the type variable `a` from the instance header. + For example, the SPECIALISE instance pragma above is a shorthand for + + {-# SPECIALISE instance forall a. Eq a => Eq (T [a]) #-} + + which is alpha-equivalent to + + {-# SPECIALISE instance forall b. Eq b => Eq (T [b]) #-} + + This shows that the type variables are not bound in the header. + + Getting this scoping wrong can lead to out-of-scope type variable errors from + Core Lint, see e.g. #22913. +-} rnMethodBindLHS :: Bool -> Name -> LHsBindLR GhcPs GhcPs ===================================== testsuite/driver/runtests.py ===================================== @@ -26,7 +26,9 @@ from pathlib import Path # So we import it here first, so that the testsuite doesn't appear to fail. import subprocess -from testutil import getStdout, Watcher, str_warn, str_info, print_table, shorten_metric_name +from concurrent.futures import ThreadPoolExecutor + +from testutil import getStdout, str_warn, str_info, print_table, shorten_metric_name from testglobals import getConfig, ghc_env, getTestRun, TestConfig, \ TestOptions, brokens, PerfMetric from my_typing import TestName @@ -151,7 +153,6 @@ config.broken_tests |= {TestName(t) for t in args.broken_test} if args.threads: config.threads = args.threads - config.use_threads = True if args.verbose is not None: config.verbose = args.verbose @@ -481,26 +482,28 @@ if config.list_broken: print('WARNING:', len(t.framework_failures), 'framework failures!') print('') else: - # completion watcher - watcher = Watcher(len(parallelTests)) - # Now run all the tests try: - for oneTest in parallelTests: - if stopping(): - break - oneTest(watcher) + with ThreadPoolExecutor(max_workers=config.threads) as executor: + for oneTest in parallelTests: + if stopping(): + break + oneTest(executor) - # wait for parallel tests to finish - if not stopping(): - watcher.wait() + # wait for parallel tests to finish + if not stopping(): + executor.shutdown(wait=True) # Run the following tests purely sequential - config.use_threads = False - for oneTest in aloneTests: - if stopping(): - break - oneTest(watcher) + with ThreadPoolExecutor(max_workers=1) as executor: + for oneTest in aloneTests: + if stopping(): + break + oneTest(executor) + + if not stopping(): + executor.shutdown(wait=True) + except KeyboardInterrupt: pass ===================================== testsuite/driver/testglobals.py ===================================== @@ -177,7 +177,6 @@ class TestConfig: # threads self.threads = 1 - self.use_threads = False # tests which should be considered to be broken during this testsuite # run. ===================================== testsuite/driver/testlib.py ===================================== @@ -36,10 +36,7 @@ from my_typing import * from threading import Timer from collections import OrderedDict -global pool_sema -if config.use_threads: - import threading - pool_sema = threading.BoundedSemaphore(value=config.threads) +import threading global wantToStop wantToStop = False @@ -84,12 +81,7 @@ def get_all_ways() -> Set[WayName]: # testdir_testopts after each test). global testopts_local -if config.use_threads: - testopts_local = threading.local() -else: - class TestOpts_Local: - pass - testopts_local = TestOpts_Local() # type: ignore +testopts_local = threading.local() def getTestOpts() -> TestOptions: return testopts_local.x @@ -1020,16 +1012,8 @@ parallelTests = [] aloneTests = [] allTestNames = set([]) # type: Set[TestName] -def runTest(watcher, opts, name: TestName, func, args): - if config.use_threads: - pool_sema.acquire() - t = threading.Thread(target=test_common_thread, - name=name, - args=(watcher, name, opts, func, args)) - t.daemon = False - t.start() - else: - test_common_work(watcher, name, opts, func, args) +def runTest(executor, opts, name: TestName, func, args): + return executor.submit(test_common_work, name, opts, func, args) # name :: String # setup :: [TestOpt] -> IO () @@ -1067,20 +1051,13 @@ def test(name: TestName, if name in config.broken_tests: myTestOpts.expect = 'fail' - thisTest = lambda watcher: runTest(watcher, myTestOpts, name, func, args) + thisTest = lambda executor: runTest(executor, myTestOpts, name, func, args) if myTestOpts.alone: aloneTests.append(thisTest) else: parallelTests.append(thisTest) allTestNames.add(name) -if config.use_threads: - def test_common_thread(watcher, name, opts, func, args): - try: - test_common_work(watcher, name, opts, func, args) - finally: - pool_sema.release() - def get_package_cache_timestamp() -> float: if config.package_conf_cache_file is None: return 0.0 @@ -1094,8 +1071,7 @@ do_not_copy = ('.hi', '.o', '.dyn_hi' , '.dyn_o', '.out' ,'.hi-boot', '.o-boot') # 12112 -def test_common_work(watcher: testutil.Watcher, - name: TestName, opts, +def test_common_work(name: TestName, opts, func, args) -> None: try: t.total_tests += 1 @@ -1214,8 +1190,6 @@ def test_common_work(watcher: testutil.Watcher, except Exception as e: framework_fail(name, None, 'Unhandled exception: ' + str(e)) - finally: - watcher.notify() def do_test(name: TestName, way: WayName, ===================================== testsuite/driver/testutil.py ===================================== @@ -5,8 +5,6 @@ import tempfile from pathlib import Path, PurePath from term_color import Color, colored -import threading - from my_typing import * @@ -125,24 +123,6 @@ else: else: os.symlink(str(src), str(dst)) -class Watcher(object): - def __init__(self, count: int) -> None: - self.pool = count - self.evt = threading.Event() - self.sync_lock = threading.Lock() - if count <= 0: - self.evt.set() - - def wait(self): - self.evt.wait() - - def notify(self): - self.sync_lock.acquire() - self.pool -= 1 - if self.pool <= 0: - self.evt.set() - self.sync_lock.release() - def memoize(f): """ A decorator to memoize a nullary function. ===================================== testsuite/tests/ghc-api/exactprint/T22919.hs ===================================== @@ -0,0 +1,2 @@ +module T22919 {- comment -} where +foo = 's' ===================================== testsuite/tests/ghc-api/exactprint/T22919.stderr ===================================== @@ -0,0 +1,116 @@ + +==================== Parser AST ==================== + +(L + { T22919.hs:1:1 } + (HsModule + (XModulePs + (EpAnn + (Anchor + { T22919.hs:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnModule (EpaSpan { T22919.hs:1:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { T22919.hs:1:29-33 }))] + (AnnList + (Nothing) + (Nothing) + (Nothing) + [] + []) + (Just + ((,) + { T22919.hs:3:1 } + { T22919.hs:2:7-9 }))) + (EpaCommentsBalanced + [(L + (Anchor + { T22919.hs:1:15-27 } + (UnchangedAnchor)) + (EpaComment + (EpaBlockComment + "{- comment -}") + { T22919.hs:1:8-13 }))] + [])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) + (Just + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:1:8-13 }) + {ModuleName: T22919})) + (Nothing) + [] + [(L + (SrcSpanAnn (EpAnn + (Anchor + { T22919.hs:2:1-9 } + (UnchangedAnchor)) + (AnnListItem + []) + (EpaComments + [])) { T22919.hs:2:1-9 }) + (ValD + (NoExtField) + (FunBind + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-3 }) + (Unqual + {OccName: foo})) + (MG + (FromSource) + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-9 }) + [(L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-9 }) + (Match + (EpAnn + (Anchor + { T22919.hs:2:1-9 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (FunRhs + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-3 }) + (Unqual + {OccName: foo})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (EpaComments + []) + [(L + (SrcSpanAnn + (EpAnnNotUsed) + { T22919.hs:2:5-9 }) + (GRHS + (EpAnn + (Anchor + { T22919.hs:2:5-9 } + (UnchangedAnchor)) + (GrhsAnn + (Nothing) + (AddEpAnn AnnEqual (EpaSpan { T22919.hs:2:5 }))) + (EpaComments + [])) + [] + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:7-9 }) + (HsLit + (EpAnn + (Anchor + { T22919.hs:2:7-9 } + (UnchangedAnchor)) + (NoEpAnns) + (EpaComments + [])) + (HsChar + (SourceText 's') + ('s'))))))] + (EmptyLocalBinds + (NoExtField)))))])))))])) ===================================== testsuite/tests/ghc-api/exactprint/Test20239.stderr ===================================== @@ -23,7 +23,14 @@ { Test20239.hs:8:1 } { Test20239.hs:7:34-63 }))) (EpaCommentsBalanced - [] + [(L + (Anchor + { Test20239.hs:3:1-28 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- | Leading Haddock Comment") + { Test20239.hs:1:18-22 }))] [(L (Anchor { Test20239.hs:7:34-63 } @@ -50,14 +57,7 @@ (AnnListItem []) (EpaComments - [(L - (Anchor - { Test20239.hs:3:1-28 } - (UnchangedAnchor)) - (EpaComment - (EpaLineComment - "-- | Leading Haddock Comment") - { Test20239.hs:1:18-22 }))])) { Test20239.hs:(4,1)-(6,86) }) + [])) { Test20239.hs:(4,1)-(6,86) }) (InstD (NoExtField) (DataFamInstD @@ -323,5 +323,5 @@ -Test20239.hs:4:15: error: [GHC-76037] +Test20239.hs:4:15: [GHC-76037] Not in scope: type constructor or class ‘Method’ ===================================== testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr ===================================== @@ -30,7 +30,15 @@ (EpaComment (EpaLineComment "-- leading comments") - { ZeroWidthSemi.hs:1:22-26 }))] + { ZeroWidthSemi.hs:1:22-26 })) + ,(L + (Anchor + { ZeroWidthSemi.hs:5:1-19 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- Function comment") + { ZeroWidthSemi.hs:3:1-19 }))] [(L (Anchor { ZeroWidthSemi.hs:8:1-58 } @@ -57,14 +65,7 @@ (AnnListItem []) (EpaComments - [(L - (Anchor - { ZeroWidthSemi.hs:5:1-19 } - (UnchangedAnchor)) - (EpaComment - (EpaLineComment - "-- Function comment") - { ZeroWidthSemi.hs:3:1-19 }))])) { ZeroWidthSemi.hs:6:1-5 }) + [])) { ZeroWidthSemi.hs:6:1-5 }) (ValD (NoExtField) (FunBind ===================================== testsuite/tests/ghc-api/exactprint/all.T ===================================== @@ -38,3 +38,4 @@ test('AddHiding1', ignore_stderr, makefile_test, ['AddHiding1']) test('AddHiding2', ignore_stderr, makefile_test, ['AddHiding2']) test('Test20239', normal, compile_fail, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments']) test('ZeroWidthSemi', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments']) +test('T22919', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments']) ===================================== testsuite/tests/parser/should_compile/DumpParsedAstComments.hs ===================================== @@ -4,6 +4,9 @@ -} module DumpParsedAstComments where +-- comment 1 for bar +-- comment 2 for bar +bar = 1 -- Other comment -- comment 1 for foo ===================================== testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr ===================================== @@ -21,8 +21,8 @@ []) (Just ((,) - { DumpParsedAstComments.hs:17:1 } - { DumpParsedAstComments.hs:16:17-23 }))) + { DumpParsedAstComments.hs:20:1 } + { DumpParsedAstComments.hs:19:17-23 }))) (EpaCommentsBalanced [(L (Anchor @@ -42,12 +42,20 @@ { DumpParsedAstComments.hs:1:1-28 })) ,(L (Anchor - { DumpParsedAstComments.hs:7:1-16 } + { DumpParsedAstComments.hs:7:1-20 } (UnchangedAnchor)) (EpaComment (EpaLineComment - "-- Other comment") - { DumpParsedAstComments.hs:5:30-34 }))] + "-- comment 1 for bar") + { DumpParsedAstComments.hs:5:30-34 })) + ,(L + (Anchor + { DumpParsedAstComments.hs:8:1-20 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- comment 2 for bar") + { DumpParsedAstComments.hs:7:1-20 }))] [])) (VirtualBraces (1)) @@ -62,55 +70,139 @@ [(L (SrcSpanAnn (EpAnn (Anchor - { DumpParsedAstComments.hs:(11,1)-(13,3) } + { DumpParsedAstComments.hs:9:1-7 } + (UnchangedAnchor)) + (AnnListItem + []) + (EpaComments + [])) { DumpParsedAstComments.hs:9:1-7 }) + (ValD + (NoExtField) + (FunBind + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-3 }) + (Unqual + {OccName: bar})) + (MG + (FromSource) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-7 }) + [(L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-7 }) + (Match + (EpAnn + (Anchor + { DumpParsedAstComments.hs:9:1-7 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (FunRhs + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-3 }) + (Unqual + {OccName: bar})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (EpaComments + []) + [(L + (SrcSpanAnn + (EpAnnNotUsed) + { DumpParsedAstComments.hs:9:5-7 }) + (GRHS + (EpAnn + (Anchor + { DumpParsedAstComments.hs:9:5-7 } + (UnchangedAnchor)) + (GrhsAnn + (Nothing) + (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:9:5 }))) + (EpaComments + [])) + [] + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:7 }) + (HsOverLit + (EpAnn + (Anchor + { DumpParsedAstComments.hs:9:7 } + (UnchangedAnchor)) + (NoEpAnns) + (EpaComments + [])) + (OverLit + (NoExtField) + (HsIntegral + (IL + (SourceText 1) + (False) + (1))))))))] + (EmptyLocalBinds + (NoExtField)))))]))))) + ,(L + (SrcSpanAnn (EpAnn + (Anchor + { DumpParsedAstComments.hs:(14,1)-(16,3) } (UnchangedAnchor)) (AnnListItem []) (EpaComments [(L (Anchor - { DumpParsedAstComments.hs:9:1-20 } + { DumpParsedAstComments.hs:10:1-16 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- Other comment") + { DumpParsedAstComments.hs:9:7 })) + ,(L + (Anchor + { DumpParsedAstComments.hs:12:1-20 } (UnchangedAnchor)) (EpaComment (EpaLineComment "-- comment 1 for foo") - { DumpParsedAstComments.hs:7:1-16 })) + { DumpParsedAstComments.hs:10:1-16 })) ,(L (Anchor - { DumpParsedAstComments.hs:10:1-20 } + { DumpParsedAstComments.hs:13:1-20 } (UnchangedAnchor)) (EpaComment (EpaLineComment "-- comment 2 for foo") - { DumpParsedAstComments.hs:9:1-20 - }))])) { DumpParsedAstComments.hs:(11,1)-(13,3) }) + { DumpParsedAstComments.hs:12:1-20 + }))])) { DumpParsedAstComments.hs:(14,1)-(16,3) }) (ValD (NoExtField) (FunBind (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:11:1-3 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:14:1-3 }) (Unqual {OccName: foo})) (MG (FromSource) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,1)-(13,3) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(14,1)-(16,3) }) [(L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,1)-(13,3) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(14,1)-(16,3) }) (Match (EpAnn (Anchor - { DumpParsedAstComments.hs:(11,1)-(13,3) } + { DumpParsedAstComments.hs:(14,1)-(16,3) } (UnchangedAnchor)) [] (EpaComments [])) (FunRhs (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:11:1-3 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:14:1-3 }) (Unqual {OccName: foo})) (Prefix) @@ -122,72 +214,72 @@ [(L (SrcSpanAnn (EpAnnNotUsed) - { DumpParsedAstComments.hs:(11,5)-(13,3) }) + { DumpParsedAstComments.hs:(14,5)-(16,3) }) (GRHS (EpAnn (Anchor - { DumpParsedAstComments.hs:(11,5)-(13,3) } + { DumpParsedAstComments.hs:(14,5)-(16,3) } (UnchangedAnchor)) (GrhsAnn (Nothing) - (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:11:5 }))) + (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:14:5 }))) (EpaComments [])) [] (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,7)-(13,3) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(14,7)-(16,3) }) (HsDo (EpAnn (Anchor - { DumpParsedAstComments.hs:(11,7)-(13,3) } + { DumpParsedAstComments.hs:(14,7)-(16,3) } (UnchangedAnchor)) (AnnList (Just (Anchor - { DumpParsedAstComments.hs:13:3 } + { DumpParsedAstComments.hs:16:3 } (UnchangedAnchor))) (Nothing) (Nothing) - [(AddEpAnn AnnDo (EpaSpan { DumpParsedAstComments.hs:11:7-8 }))] + [(AddEpAnn AnnDo (EpaSpan { DumpParsedAstComments.hs:14:7-8 }))] []) (EpaComments [(L (Anchor - { DumpParsedAstComments.hs:12:3-19 } + { DumpParsedAstComments.hs:15:3-19 } (UnchangedAnchor)) (EpaComment (EpaLineComment "-- normal comment") - { DumpParsedAstComments.hs:11:7-8 }))])) + { DumpParsedAstComments.hs:14:7-8 }))])) (DoExpr (Nothing)) (L (SrcSpanAnn (EpAnn (Anchor - { DumpParsedAstComments.hs:13:3 } + { DumpParsedAstComments.hs:16:3 } (UnchangedAnchor)) (AnnList (Just (Anchor - { DumpParsedAstComments.hs:13:3 } + { DumpParsedAstComments.hs:16:3 } (UnchangedAnchor))) (Nothing) (Nothing) [] []) (EpaComments - [])) { DumpParsedAstComments.hs:13:3 }) + [])) { DumpParsedAstComments.hs:16:3 }) [(L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:13:3 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:3 }) (BodyStmt (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:13:3 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:3 }) (HsOverLit (EpAnn (Anchor - { DumpParsedAstComments.hs:13:3 } + { DumpParsedAstComments.hs:16:3 } (UnchangedAnchor)) (NoEpAnns) (EpaComments @@ -206,45 +298,45 @@ ,(L (SrcSpanAnn (EpAnn (Anchor - { DumpParsedAstComments.hs:16:1-23 } + { DumpParsedAstComments.hs:19:1-23 } (UnchangedAnchor)) (AnnListItem []) (EpaComments [(L (Anchor - { DumpParsedAstComments.hs:15:1-20 } + { DumpParsedAstComments.hs:18:1-20 } (UnchangedAnchor)) (EpaComment (EpaLineComment "-- | Haddock comment") - { DumpParsedAstComments.hs:13:3 - }))])) { DumpParsedAstComments.hs:16:1-23 }) + { DumpParsedAstComments.hs:16:3 + }))])) { DumpParsedAstComments.hs:19:1-23 }) (ValD (NoExtField) (FunBind (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-4 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-4 }) (Unqual {OccName: main})) (MG (FromSource) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-23 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-23 }) [(L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-23 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-23 }) (Match (EpAnn (Anchor - { DumpParsedAstComments.hs:16:1-23 } + { DumpParsedAstComments.hs:19:1-23 } (UnchangedAnchor)) [] (EpaComments [])) (FunRhs (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-4 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-4 }) (Unqual {OccName: main})) (Prefix) @@ -256,42 +348,42 @@ [(L (SrcSpanAnn (EpAnnNotUsed) - { DumpParsedAstComments.hs:16:6-23 }) + { DumpParsedAstComments.hs:19:6-23 }) (GRHS (EpAnn (Anchor - { DumpParsedAstComments.hs:16:6-23 } + { DumpParsedAstComments.hs:19:6-23 } (UnchangedAnchor)) (GrhsAnn (Nothing) - (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:16:6 }))) + (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:19:6 }))) (EpaComments [])) [] (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-23 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:8-23 }) (HsApp (EpAnn (Anchor - { DumpParsedAstComments.hs:16:8-23 } + { DumpParsedAstComments.hs:19:8-23 } (UnchangedAnchor)) (NoEpAnns) (EpaComments [])) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-15 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:8-15 }) (HsVar (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-15 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:8-15 }) (Unqual {OccName: putStrLn})))) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:17-23 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:17-23 }) (HsLit (EpAnn (Anchor - { DumpParsedAstComments.hs:16:17-23 } + { DumpParsedAstComments.hs:19:17-23 } (UnchangedAnchor)) (NoEpAnns) (EpaComments ===================================== testsuite/tests/rename/should_compile/T22913.hs ===================================== @@ -0,0 +1,10 @@ +module T22913 where + +class FromSourceIO a where + fromSourceIO :: a +instance FromSourceIO (Maybe o) where + fromSourceIO = undefined + {-# SPECIALISE INLINE fromSourceIO :: Maybe o #-} + -- This SPECIALISE pragma caused a Core Lint error + -- due to incorrectly scoping the type variable 'o' from the instance header + -- over the SPECIALISE pragma. ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -199,3 +199,4 @@ test('T22513f', normal, compile, ['-Wterm-variable-capture']) test('T22513g', normal, compile, ['-Wterm-variable-capture']) test('T22513h', normal, compile, ['-Wterm-variable-capture']) test('T22513i', req_th, compile, ['-Wterm-variable-capture']) +test('T22913', normal, compile, ['']) ===================================== testsuite/tests/simplCore/should_compile/T21148.hs deleted ===================================== @@ -1,12 +0,0 @@ -module T211148 where - --- The point of this test is that f should get a (nested) --- CPR property, with a worker of type --- $wf :: Int# -> State# RealWorld -> (# State# RealWorld, Int# #) - -{-# NOINLINE f #-} --- The NOINLINE makes GHC do a worker/wrapper split --- even though f is small -f :: Int -> IO Int -f x = return $! sum [0..x] - ===================================== testsuite/tests/simplCore/should_compile/T21148.stderr deleted ===================================== @@ -1,126 +0,0 @@ - -==================== Tidy Core ==================== -Result size of Tidy Core - = {terms: 73, types: 80, coercions: 6, joins: 2/2} - --- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule4 :: GHC.Prim.Addr# -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] -T211148.$trModule4 = "main"# - --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule3 :: GHC.Types.TrName -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -T211148.$trModule3 = GHC.Types.TrNameS T211148.$trModule4 - --- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule2 :: GHC.Prim.Addr# -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] -T211148.$trModule2 = "T211148"# - --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule1 :: GHC.Types.TrName -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -T211148.$trModule1 = GHC.Types.TrNameS T211148.$trModule2 - --- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule :: GHC.Types.Module -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -T211148.$trModule - = GHC.Types.Module T211148.$trModule3 T211148.$trModule1 - --- RHS size: {terms: 41, types: 35, coercions: 0, joins: 2/2} -T211148.$wf [InlPrag=NOINLINE] - :: GHC.Prim.Int# - -> GHC.Prim.State# GHC.Prim.RealWorld - -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #) -[GblId, Arity=2, Str=, Unf=OtherCon []] -T211148.$wf - = \ (ww_s179 :: GHC.Prim.Int#) - (eta_s17b [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld) -> - case GHC.Prim.># 0# ww_s179 of { - __DEFAULT -> - join { - exit_X0 [Dmd=SC(S,C(1,!P(L,L)))] - :: GHC.Prim.Int# - -> GHC.Prim.Int# - -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #) - [LclId[JoinId(2)(Nothing)], Arity=2, Str=] - exit_X0 (x_s16Z [OS=OneShot] :: GHC.Prim.Int#) - (ww1_s172 [OS=OneShot] :: GHC.Prim.Int#) - = (# eta_s17b, GHC.Prim.+# ww1_s172 x_s16Z #) } in - joinrec { - $wgo3_s175 [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,C(1,!P(L,L)))] - :: GHC.Prim.Int# - -> GHC.Prim.Int# - -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #) - [LclId[JoinId(2)(Nothing)], Arity=2, Str=, Unf=OtherCon []] - $wgo3_s175 (x_s16Z :: GHC.Prim.Int#) (ww1_s172 :: GHC.Prim.Int#) - = case GHC.Prim.==# x_s16Z ww_s179 of { - __DEFAULT -> - jump $wgo3_s175 - (GHC.Prim.+# x_s16Z 1#) (GHC.Prim.+# ww1_s172 x_s16Z); - 1# -> jump exit_X0 x_s16Z ww1_s172 - }; } in - jump $wgo3_s175 0# 0#; - 1# -> (# eta_s17b, 0# #) - } - --- RHS size: {terms: 14, types: 19, coercions: 0, joins: 0/0} -T211148.f1 [InlPrag=NOINLINE[final]] - :: Int - -> GHC.Prim.State# GHC.Prim.RealWorld - -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #) -[GblId, - Arity=2, - Str=<1!P(L)>, - Cpr=1(, 1), - Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (x_s177 [Occ=Once1!] :: Int) - (eta_s17b [Occ=Once1, OS=OneShot] - :: GHC.Prim.State# GHC.Prim.RealWorld) -> - case x_s177 of { GHC.Types.I# ww_s179 [Occ=Once1] -> - case T211148.$wf ww_s179 eta_s17b of - { (# ww1_s17e [Occ=Once1], ww2_s17j [Occ=Once1] #) -> - (# ww1_s17e, GHC.Types.I# ww2_s17j #) - } - }}] -T211148.f1 - = \ (x_s177 :: Int) - (eta_s17b [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld) -> - case x_s177 of { GHC.Types.I# ww_s179 -> - case T211148.$wf ww_s179 eta_s17b of { (# ww1_s17e, ww2_s17j #) -> - (# ww1_s17e, GHC.Types.I# ww2_s17j #) - } - } - --- RHS size: {terms: 1, types: 0, coercions: 6, joins: 0/0} -f [InlPrag=NOINLINE[final]] :: Int -> IO Int -[GblId, - Arity=2, - Str=<1!P(L)>, - Cpr=1(, 1), - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}] -f = T211148.f1 - `cast` (_R %<'Many>_N ->_R Sym (GHC.Types.N:IO[0] _R) - :: (Int - -> GHC.Prim.State# GHC.Prim.RealWorld - -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)) - ~R# (Int -> IO Int)) - - - ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -429,7 +429,6 @@ test('T21763a', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) test('T22028', normal, compile, ['-O -ddump-rule-firings']) test('T22114', normal, compile, ['-O']) test('T21286', normal, multimod_compile, ['T21286', '-O -ddump-rule-firings']) -test('T21148', [grep_errmsg(r'Cpr=') ], compile, ['-O -ddump-simpl']) # One module, T21851.hs, has OPTIONS_GHC -ddump-simpl test('T21851', [grep_errmsg(r'case.*w\$sf') ], multimod_compile, ['T21851', '-O -dno-typeable-binds -dsuppress-uniques']) ===================================== testsuite/tests/stranal/should_compile/T21128.hs ===================================== @@ -2,10 +2,6 @@ module T21128 where import T21128a -{- This test originally had some unnecessary reboxing of y -in the hot path of $wtheresCrud. That reboxing should -not happen. -} - theresCrud :: Int -> Int -> Int theresCrud x y = go x where @@ -13,4 +9,3 @@ theresCrud x y = go x go 1 = index x y 1 go n = go (n-1) {-# NOINLINE theresCrud #-} - ===================================== testsuite/tests/stranal/should_compile/T21128.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 125, types: 68, coercions: 4, joins: 0/0} + = {terms: 137, types: 92, coercions: 4, joins: 0/0} lvl = "error"# @@ -29,11 +29,17 @@ lvl9 = SrcLoc lvl2 lvl3 lvl5 lvl6 lvl7 lvl6 lvl8 lvl10 = PushCallStack lvl1 lvl9 EmptyCallStack +$windexError + = \ @a @b ww eta eta1 eta2 -> + error + (lvl10 `cast` :: CallStack ~R# (?callStack::CallStack)) + (++ (ww eta) (++ (ww eta1) (ww eta2))) + indexError = \ @a @b $dShow eta eta1 eta2 -> - error - (lvl10 `cast` :: ...) - (++ (show $dShow eta) (++ (show $dShow eta1) (show $dShow eta2))) + case $dShow of { C:Show ww ww1 ww2 -> + $windexError ww1 eta eta1 eta2 + } $trModule3 = TrNameS $trModule4 @@ -42,7 +48,8 @@ $trModule1 = TrNameS $trModule2 $trModule = Module $trModule3 $trModule1 $wlvl - = \ ww ww1 ww2 -> indexError $fShowInt (I# ww2) (I# ww1) (I# ww) + = \ ww ww1 ww2 -> + $windexError $fShowInt_$cshow (I# ww2) (I# ww1) (I# ww) index = \ l u i -> @@ -66,7 +73,7 @@ index ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 108, types: 46, coercions: 0, joins: 3/3} + = {terms: 108, types: 47, coercions: 0, joins: 3/4} $trModule4 = "main"# @@ -82,34 +89,35 @@ i = I# 1# l = I# 0# -lvl = \ x ww -> indexError $fShowInt x (I# ww) i +lvl = \ y -> $windexError $fShowInt_$cshow l y l -lvl1 = \ ww -> indexError $fShowInt l (I# ww) l +lvl1 = \ ww y -> $windexError $fShowInt_$cshow (I# ww) y i $wtheresCrud = \ ww ww1 -> + let { y = I# ww1 } in join { - exit - = case <# 0# ww1 of { - __DEFAULT -> case lvl1 ww1 of wild { }; - 1# -> 0# - } } in - join { - exit1 + lvl2 = case <=# ww 1# of { - __DEFAULT -> case lvl (I# ww) ww1 of wild { }; + __DEFAULT -> case lvl1 ww y of wild { }; 1# -> case <# 1# ww1 of { - __DEFAULT -> case lvl (I# ww) ww1 of wild { }; + __DEFAULT -> case lvl1 ww y of wild { }; 1# -> -# 1# ww } } } in + join { + lvl3 + = case <# 0# ww1 of { + __DEFAULT -> case lvl y of wild { }; + 1# -> 0# + } } in joinrec { $wgo ww2 = case ww2 of wild { __DEFAULT -> jump $wgo (-# wild 1#); - 0# -> jump exit; - 1# -> jump exit1 + 0# -> jump lvl3; + 1# -> jump lvl2 }; } in jump $wgo ww View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/22085bcdf8b5ebf8e8a9b30fb74fbe400616c12c...d5b5c07c71ecb652d4594e5d6eddfdd28d4f060c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/22085bcdf8b5ebf8e8a9b30fb74fbe400616c12c...d5b5c07c71ecb652d4594e5d6eddfdd28d4f060c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 22:07:12 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 08 Feb 2023 17:07:12 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T22908 Message-ID: <63e41d10698d2_2b039a526701159a9@gitlab.mail> Simon Peyton Jones pushed new branch wip/T22908 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22908 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 22:45:49 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 08 Feb 2023 17:45:49 -0500 Subject: [Git][ghc/ghc][wip/T22924] 5 commits: JS: avoid head/tail and unpackFS Message-ID: <63e4261dc0f0_2b039a527601592c8@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22924 at Glasgow Haskell Compiler / GHC Commits: c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - c8d18d0a by Simon Peyton Jones at 2023-02-08T22:46:35+00:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. This makes Note [Unwrap newtypes first], Case 1, seem very narrow and contrived: doing newtype unwrapping in the rewriter no longer looks as helpful as it did in #22519. But it does no harm so I'm leaving it in. - - - - - 19 changed files: - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/StgToJS/Printer.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/InertSet.hs - testsuite/driver/runtests.py - testsuite/driver/testlib.py - + testsuite/tests/rename/should_compile/T22913.hs - testsuite/tests/rename/should_compile/all.T - − testsuite/tests/simplCore/should_compile/T21148.hs - − testsuite/tests/simplCore/should_compile/T21148.stderr - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/stranal/should_compile/T21128.hs - testsuite/tests/stranal/should_compile/T21128.stderr Changes: ===================================== compiler/GHC/Core/Opt/Exitify.hs ===================================== @@ -433,7 +433,6 @@ inlining. Exit join points, recognizable using `isExitJoinId` are join points with an occurrence in a recursive group, and can be recognized (after the occurrence analyzer ran!) using `isExitJoinId`. - This function detects joinpoints with `occ_in_lam (idOccinfo id) == True`, because the lambdas of a non-recursive join point are not considered for `occ_in_lam`. For example, in the following code, `j1` is /not/ marked @@ -447,29 +446,6 @@ To prevent inlining, we check for isExitJoinId * In `simplLetUnfolding` we simply give exit join points no unfolding, which prevents inlining in `postInlineUnconditionally` and call sites. -But see Note [Be selective about not-inlining exit join points] - -Note [Be selective about not-inlining exit join points] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If we follow "do not inline exit join points" mantra throughout, -some bad things happen. - -* We can lose CPR information: see #21148 - -* We get useless clutter (#22084) that - - makes the program bigger (including duplicated code #20739), and - - adds extra jumps (and maybe stack saves) at runtime - -So instead we follow "do not inline exit join points" for a /single run/ -of the simplifier, right after Exitification. That should give a -sufficient chance for used-once things to inline, but subsequent runs -will inline them back in. (Annoyingly, as things stand, only with -O2 -is there a subsequent run, but that might change, and it's not a huge -deal anyway.) - -This is controlled by the Simplifier's sm_keep_exits flag; see -GHC.Core.Opt.Pipeline. - Note [Placement of the exitification pass] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ I (Joachim) experimented with multiple positions for the Exitification pass in ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -15,7 +15,7 @@ import GHC.Driver.Plugins ( withPlugins, installCoreToDos ) import GHC.Driver.Env import GHC.Driver.Config.Core.Lint ( endPass ) import GHC.Driver.Config.Core.Opt.LiberateCase ( initLiberateCaseOpts ) -import GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyOpts, initSimplMode ) +import GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyOpts, initSimplMode, initGentleSimplMode ) import GHC.Driver.Config.Core.Opt.WorkWrap ( initWorkWrapOpts ) import GHC.Driver.Config.Core.Rules ( initRuleOpts ) import GHC.Platform.Ways ( hasWay, Way(WayProf) ) @@ -28,7 +28,6 @@ import GHC.Core.Utils ( dumpIdInfoOfProgram ) import GHC.Core.Lint ( lintAnnots ) import GHC.Core.Lint.Interactive ( interactiveInScope ) import GHC.Core.Opt.Simplify ( simplifyExpr, simplifyPgm ) -import GHC.Core.Opt.Simplify.Env( SimplMode(..) ) import GHC.Core.Opt.Simplify.Monad import GHC.Core.Opt.Monad import GHC.Core.Opt.Pipeline.Types @@ -153,45 +152,32 @@ getCoreToDo dflags hpt_rule_base extra_vars maybe_strictness_before _ = CoreDoNothing - ---------------------------- - base_simpl_mode :: SimplMode - base_simpl_mode = initSimplMode dflags - - -- gentle_mode: make specialiser happy: minimum effort please - -- See Note [Inline in InitialPhase] - -- See Note [RULEs enabled in InitialPhase] - gentle_mode = base_simpl_mode { sm_names = ["Gentle"] - , sm_phase = InitialPhase - , sm_case_case = False } - - simpl_mode phase name - = base_simpl_mode { sm_names = [name], sm_phase = phase } - - keep_exits :: SimplMode -> SimplMode - -- See Note [Be selective about not-inlining exit join points] - -- in GHC.Core.Opt.Exitify - keep_exits mode = mode { sm_keep_exits = True } - - ---------------------------- - run_simplifier mode iter - = CoreDoSimplify $ initSimplifyOpts dflags extra_vars iter mode hpt_rule_base - - simpl_phase phase name iter = CoreDoPasses $ - [ maybe_strictness_before phase - , run_simplifier (simpl_mode phase name) iter - , maybe_rule_check phase ] + simpl_phase phase name iter + = CoreDoPasses + $ [ maybe_strictness_before phase + , CoreDoSimplify $ initSimplifyOpts dflags extra_vars iter + (initSimplMode dflags phase name) hpt_rule_base + , maybe_rule_check phase ] -- Run GHC's internal simplification phase, after all rules have run. -- See Note [Compiler phases] in GHC.Types.Basic - simpl_gently = run_simplifier gentle_mode max_iter - simplify_final name = run_simplifier ( simpl_mode FinalPhase name) max_iter - simpl_keep_exits name = run_simplifier (keep_exits $ simpl_mode FinalPhase name) max_iter + simplify name = simpl_phase FinalPhase name max_iter + + -- initial simplify: mk specialiser happy: minimum effort please + -- See Note [Inline in InitialPhase] + -- See Note [RULEs enabled in InitialPhase] + simpl_gently = CoreDoSimplify $ initSimplifyOpts dflags extra_vars max_iter + (initGentleSimplMode dflags) hpt_rule_base - ---------------------------- dmd_cpr_ww = if ww_on then [CoreDoDemand True,CoreDoCpr,CoreDoWorkerWrapper] else [CoreDoDemand False] -- NB: No CPR! See Note [Don't change boxity without worker/wrapper] + demand_analyser = (CoreDoPasses ( + dmd_cpr_ww ++ + [simplify "post-worker-wrapper"] + )) + -- Static forms are moved to the top level with the FloatOut pass. -- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable. static_ptrs_float_outwards = @@ -281,16 +267,14 @@ getCoreToDo dflags hpt_rule_base extra_vars runWhen call_arity $ CoreDoPasses [ CoreDoCallArity - , simplify_final "post-call-arity" + , simplify "post-call-arity" ], -- Strictness analysis - runWhen strictness $ CoreDoPasses - (dmd_cpr_ww ++ [simplify_final "post-worker-wrapper"]), + runWhen strictness demand_analyser, runWhen exitification CoreDoExitify, -- See Note [Placement of the exitification pass] - -- in GHC.Core.Opt.Exitify runWhen full_laziness $ CoreDoFloatOutwards FloatOutSwitches { @@ -312,17 +296,7 @@ getCoreToDo dflags hpt_rule_base extra_vars runWhen do_float_in CoreDoFloatInwards, - -- Final tidy-up run of the simplifier - simpl_keep_exits "final tidy up", - -- Keep exit join point because this is the first - -- Simplifier run after Exitify. Subsequent runs will - -- re-inline those exit join points; their work is done. - -- See Note [Be selective about not-inlining exit join points] - -- in GHC.Core.Opt.Exitify - -- - -- Annoyingly, we only /have/ a subsequent run with -O2. With - -- plain -O we'll still have those exit join points hanging around. - -- Oh well. + simplify "final", -- Final tidy-up maybe_rule_check FinalPhase, @@ -332,31 +306,31 @@ getCoreToDo dflags hpt_rule_base extra_vars -- Case-liberation for -O2. This should be after -- strictness analysis and the simplification which follows it. runWhen liberate_case $ CoreDoPasses - [ CoreLiberateCase, simplify_final "post-liberate-case" ], + [ CoreLiberateCase, simplify "post-liberate-case" ], -- Run the simplifier after LiberateCase to vastly -- reduce the possibility of shadowing -- Reason: see Note [Shadowing] in GHC.Core.Opt.SpecConstr runWhen spec_constr $ CoreDoPasses - [ CoreDoSpecConstr, simplify_final "post-spec-constr"], + [ CoreDoSpecConstr, simplify "post-spec-constr"], -- See Note [Simplify after SpecConstr] maybe_rule_check FinalPhase, runWhen late_specialise $ CoreDoPasses - [ CoreDoSpecialising, simplify_final "post-late-spec"], + [ CoreDoSpecialising, simplify "post-late-spec"], -- LiberateCase can yield new CSE opportunities because it peels -- off one layer of a recursive function (concretely, I saw this -- in wheel-sieve1), and I'm guessing that SpecConstr can too -- And CSE is a very cheap pass. So it seems worth doing here. runWhen ((liberate_case || spec_constr) && cse) $ CoreDoPasses - [ CoreCSE, simplify_final "post-final-cse" ], + [ CoreCSE, simplify "post-final-cse" ], --------- End of -O2 passes -------------- runWhen late_dmd_anal $ CoreDoPasses ( - dmd_cpr_ww ++ [simplify_final "post-late-ww"] + dmd_cpr_ww ++ [simplify "post-late-ww"] ), -- Final run of the demand_analyser, ensures that one-shot thunks are ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -248,16 +248,13 @@ data SimplMode = SimplMode -- See comments in GHC.Core.Opt.Simplify.Monad , sm_uf_opts :: !UnfoldingOpts -- ^ Unfolding options , sm_case_case :: !Bool -- ^ Whether case-of-case is enabled , sm_pre_inline :: !Bool -- ^ Whether pre-inlining is enabled - , sm_keep_exits :: !Bool -- ^ True <=> keep ExitJoinIds - -- See Note [Do not inline exit join points] - -- in GHC.Core.Opt.Exitify - , sm_float_enable :: !FloatEnable -- ^ Whether to enable floating out + , sm_float_enable :: !FloatEnable -- ^ Whether to enable floating out , sm_do_eta_reduction :: !Bool - , sm_arity_opts :: !ArityOpts - , sm_rule_opts :: !RuleOpts - , sm_case_folding :: !Bool - , sm_case_merge :: !Bool - , sm_co_opt_opts :: !OptCoercionOpts -- ^ Coercion optimiser options + , sm_arity_opts :: !ArityOpts + , sm_rule_opts :: !RuleOpts + , sm_case_folding :: !Bool + , sm_case_merge :: !Bool + , sm_co_opt_opts :: !OptCoercionOpts -- ^ Coercion optimiser options } instance Outputable SimplMode where ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1395,11 +1395,11 @@ preInlineUnconditionally -- Reason: we don't want to inline single uses, or discard dead bindings, -- for unlifted, side-effect-ful bindings preInlineUnconditionally env top_lvl bndr rhs rhs_env - | not pre_inline = Nothing + | not pre_inline_unconditionally = Nothing | not active = Nothing | isTopLevel top_lvl && isDeadEndId bndr = Nothing -- Note [Top-level bottoming Ids] | isCoVar bndr = Nothing -- Note [Do not inline CoVars unconditionally] - | keep_exits, isExitJoinId bndr = Nothing -- Note [Do not inline exit join points] + | isExitJoinId bndr = Nothing -- Note [Do not inline exit join points] -- in module Exitify | not (one_occ (idOccInfo bndr)) = Nothing | not (isStableUnfolding unf) = Just $! (extend_subst_with rhs) @@ -1409,36 +1409,19 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env , Just inl <- maybeUnfoldingTemplate unf = Just $! (extend_subst_with inl) | otherwise = Nothing where - mode = seMode env - phase = sm_phase mode - keep_exits = sm_keep_exits mode - pre_inline = sm_pre_inline mode - unf = idUnfolding bndr extend_subst_with inl_rhs = extendIdSubst env bndr $! (mkContEx rhs_env inl_rhs) one_occ IAmDead = True -- Happens in ((\x.1) v) - one_occ OneOcc{ occ_n_br = 1 , occ_in_lam = NotInsideLam } = isNotTopLevel top_lvl || early_phase - one_occ OneOcc{ occ_n_br = 1 , occ_in_lam = IsInsideLam , occ_int_cxt = IsInteresting } = canInlineInLam rhs + one_occ _ = False - one_occ OneOcc{ occ_n_br = 1 } -- Inline join point that are used once, even inside - | isJoinId bndr = True -- lambdas (which are presumably other join points) - -- E.g. join j x = rhs in - -- joinrec k y = ....j x.... - -- Here j must be an exit for k, and we can safely inline it under the lambda - -- This includes the case where j is nullary: a nullary join point is just the - -- same as an arity-1 one. So we don't look at occ_int_cxt. - -- All of this only applies if keep_exits is False, otherwise the - -- earlier guard on preInlineUnconditionally would have fired - - one_occ _ = False - - active = isActive phase (inlinePragmaActivation inline_prag) + pre_inline_unconditionally = sePreInline env + active = isActive (sePhase env) (inlinePragmaActivation inline_prag) -- See Note [pre/postInlineUnconditionally in gentle mode] inline_prag = idInlinePragma bndr @@ -1470,7 +1453,7 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env -- not ticks. Counting ticks cannot be duplicated, and non-counting -- ticks around a Lam will disappear anyway. - early_phase = phase /= FinalPhase + early_phase = sePhase env /= FinalPhase -- If we don't have this early_phase test, consider -- x = length [1,2,3] -- The full laziness pass carefully floats all the cons cells to ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -1532,10 +1532,8 @@ scExpr' env (Case scrut b ty alts) scrut_occ = case con of DataAlt dc -- See Note [Do not specialise evals] | not (single_alt && all deadArgOcc arg_occs) - -> -- pprTrace "sc_alt1" (ppr b' $$ ppr con $$ ppr bs $$ ppr arg_occs) $ - ScrutOcc (unitUFM dc arg_occs) - _ -> -- pprTrace "sc_alt1" (ppr b' $$ ppr con $$ ppr bs $$ ppr arg_occs) $ - UnkOcc + -> ScrutOcc (unitUFM dc arg_occs) + _ -> UnkOcc ; return (usg', b_occ `combineOcc` scrut_occ, Alt con bs2 rhs') } ===================================== compiler/GHC/Driver/Config/Core/Opt/Simplify.hs ===================================== @@ -2,6 +2,7 @@ module GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyExprOpts , initSimplifyOpts , initSimplMode + , initGentleSimplMode ) where import GHC.Prelude @@ -26,13 +27,12 @@ import GHC.Types.Var ( Var ) initSimplifyExprOpts :: DynFlags -> InteractiveContext -> SimplifyExprOpts initSimplifyExprOpts dflags ic = SimplifyExprOpts { se_fam_inst = snd $ ic_instances ic - - , se_mode = (initSimplMode dflags) { sm_names = ["GHCi"] - , sm_inline = False } - -- sm_inline: do not do any inlining, in case we expose - -- some unboxed tuple stuff that confuses the bytecode + , se_mode = (initSimplMode dflags InitialPhase "GHCi") + { sm_inline = False + -- Do not do any inlining, in case we expose some + -- unboxed tuple stuff that confuses the bytecode -- interpreter - + } , se_top_env_cfg = TopEnvConfig { te_history_size = historySize dflags , te_tick_factor = simplTickFactor dflags @@ -56,25 +56,31 @@ initSimplifyOpts dflags extra_vars iterations mode hpt_rule_base = let } in opts -initSimplMode :: DynFlags -> SimplMode -initSimplMode dflags = SimplMode - { sm_names = ["Unknown simplifier run"] -- Always overriden - , sm_phase = InitialPhase - , sm_rules = gopt Opt_EnableRewriteRules dflags - , sm_eta_expand = gopt Opt_DoLambdaEtaExpansion dflags - , sm_pre_inline = gopt Opt_SimplPreInlining dflags - , sm_do_eta_reduction = gopt Opt_DoEtaReduction dflags - , sm_uf_opts = unfoldingOpts dflags - , sm_float_enable = floatEnable dflags - , sm_arity_opts = initArityOpts dflags - , sm_rule_opts = initRuleOpts dflags - , sm_case_folding = gopt Opt_CaseFolding dflags - , sm_case_merge = gopt Opt_CaseMerge dflags - , sm_co_opt_opts = initOptCoercionOpts dflags +initSimplMode :: DynFlags -> CompilerPhase -> String -> SimplMode +initSimplMode dflags phase name = SimplMode + { sm_names = [name] + , sm_phase = phase + , sm_rules = gopt Opt_EnableRewriteRules dflags + , sm_eta_expand = gopt Opt_DoLambdaEtaExpansion dflags , sm_cast_swizzle = True - , sm_inline = True - , sm_case_case = True - , sm_keep_exits = False + , sm_inline = True + , sm_uf_opts = unfoldingOpts dflags + , sm_case_case = True + , sm_pre_inline = gopt Opt_SimplPreInlining dflags + , sm_float_enable = floatEnable dflags + , sm_do_eta_reduction = gopt Opt_DoEtaReduction dflags + , sm_arity_opts = initArityOpts dflags + , sm_rule_opts = initRuleOpts dflags + , sm_case_folding = gopt Opt_CaseFolding dflags + , sm_case_merge = gopt Opt_CaseMerge dflags + , sm_co_opt_opts = initOptCoercionOpts dflags + } + +initGentleSimplMode :: DynFlags -> SimplMode +initGentleSimplMode dflags = (initSimplMode dflags InitialPhase "Gentle") + { -- Don't do case-of-case transformations. + -- This makes full laziness work better + sm_case_case = False } floatEnable :: DynFlags -> FloatEnable ===================================== compiler/GHC/Rename/Bind.hs ===================================== @@ -893,17 +893,15 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs -- Rename the pragmas and signatures -- Annoyingly the type variables /are/ in scope for signatures, but - -- /are not/ in scope in the SPECIALISE instance pramas; e.g. - -- instance Eq a => Eq (T a) where - -- (==) :: a -> a -> a - -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-} - ; let (spec_inst_prags, other_sigs) = partition isSpecInstLSig sigs + -- /are not/ in scope in SPECIALISE and SPECIALISE instance pragmas. + -- See Note [Type variable scoping in SPECIALISE pragmas]. + ; let (spec_prags, other_sigs) = partition (isSpecLSig <||> isSpecInstLSig) sigs bound_nms = mkNameSet (collectHsBindsBinders CollNoDictBinders binds') sig_ctxt | is_cls_decl = ClsDeclCtxt cls | otherwise = InstDeclCtxt bound_nms - ; (spec_inst_prags', sip_fvs) <- renameSigs sig_ctxt spec_inst_prags - ; (other_sigs', sig_fvs) <- bindLocalNamesFV ktv_names $ - renameSigs sig_ctxt other_sigs + ; (spec_prags', spg_fvs) <- renameSigs sig_ctxt spec_prags + ; (other_sigs', sig_fvs) <- bindLocalNamesFV ktv_names $ + renameSigs sig_ctxt other_sigs -- Rename the bindings RHSs. Again there's an issue about whether the -- type variables from the class/instance head are in scope. @@ -914,8 +912,47 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs emptyFVs binds_w_dus ; return (mapBag fstOf3 binds_w_dus, bind_fvs) } - ; return ( binds'', spec_inst_prags' ++ other_sigs' - , sig_fvs `plusFV` sip_fvs `plusFV` bind_fvs) } + ; return ( binds'', spec_prags' ++ other_sigs' + , sig_fvs `plusFV` spg_fvs `plusFV` bind_fvs) } + +{- Note [Type variable scoping in SPECIALISE pragmas] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When renaming the methods of a class or instance declaration, we must be careful +with the scoping of the type variables that occur in SPECIALISE and SPECIALISE instance +pragmas: the type variables from the class/instance header DO NOT scope over these, +unlike class/instance method type signatures. + +Examples: + + 1. SPECIALISE + + class C a where + meth :: a + instance C (Maybe a) where + meth = Nothing + {-# SPECIALISE INLINE meth :: Maybe [a] #-} + + 2. SPECIALISE instance + + instance Eq a => Eq (T a) where + (==) :: a -> a -> a + {-# SPECIALISE instance Eq a => Eq (T [a]) #-} + + In both cases, the type variable `a` mentioned in the PRAGMA is NOT the same + as the type variable `a` from the instance header. + For example, the SPECIALISE instance pragma above is a shorthand for + + {-# SPECIALISE instance forall a. Eq a => Eq (T [a]) #-} + + which is alpha-equivalent to + + {-# SPECIALISE instance forall b. Eq b => Eq (T [b]) #-} + + This shows that the type variables are not bound in the header. + + Getting this scoping wrong can lead to out-of-scope type variable errors from + Core Lint, see e.g. #22913. +-} rnMethodBindLHS :: Bool -> Name -> LHsBindLR GhcPs GhcPs ===================================== compiler/GHC/StgToJS/Printer.hs ===================================== @@ -108,19 +108,17 @@ ghcjsRenderJsV r (JHash m) where quoteIfRequired :: FastString -> Doc quoteIfRequired x - | isUnquotedKey x' = text x' - | otherwise = PP.squotes (text x') - where x' = unpackFS x - - isUnquotedKey :: String -> Bool - isUnquotedKey x | null x = False - | all isDigit x = True - | otherwise = validFirstIdent (head x) - && all validOtherIdent (tail x) + | isUnquotedKey x = ftext x + | otherwise = PP.squotes (ftext x) + isUnquotedKey :: FastString -> Bool + isUnquotedKey fs = case unpackFS fs of + [] -> False + s@(c:cs) -> all isDigit s || (validFirstIdent c && all validOtherIdent cs) validFirstIdent c = c == '_' || c == '$' || isAlpha c validOtherIdent c = isAlpha c || isDigit c + ghcjsRenderJsV r v = renderJsV defaultRenderJs r v prettyBlock :: RenderJs -> [JStat] -> Doc ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -1409,10 +1409,10 @@ in `can_eq_newtype_nc` But even this is challenging. Here are two cases to consider: -Case 1: +Case 1 (extremely contrived): newtype Age = MkAge Int - [G] c + [G] IO s ~ IO t -- where s,t ane not Age,Int [W] w1 :: IO Age ~R# IO Int Case 2: @@ -1422,9 +1422,9 @@ Case 2: For Case 1, recall that IO is an abstract newtype. Then read Note [Decomposing newtype equalities]. According to that Note, we should not -decompose w1, because we have an Irred Given. Yet we still want to solve -the wanted! We can do so by unwrapping the (non-abstract) Age newtype -underneath the IO, giving +decompose w1, because we have an Irred Given that stops decomposition. +Yet we still want to solve the wanted! We can do so by unwrapping the +(non-abstract) Age newtype underneath the IO, giving [W] w2 :: IO Int ~R# IO Int w1 = (IO unwrap-Age ; w2) where unwrap-Age :: Age ~R# Int. Now we case solve w2 by reflexivity; @@ -1641,7 +1641,7 @@ canTyConApp rewritten ev eq_rel tc1 tys1 tc2 tys2 ty2 = mkTyConApp tc2 tys2 -- See Note [Decomposing TyConApp equalities] - -- Note [Decomposing newtypes a bit more aggressively] + -- and Note [Decomposing newtype equalities] can_decompose inerts = isInjectiveTyCon tc1 (eqRelRole eq_rel) || (assert (eq_rel == ReprEq) $ @@ -1650,7 +1650,8 @@ canTyConApp rewritten ev eq_rel tc1 tys1 tc2 tys2 -- Moreover isInjectiveTyCon is True for Representational -- for algebraic data types. So we are down to newtypes -- and data families. - ctEvFlavour ev == Wanted && noGivenIrreds inerts) + ctEvFlavour ev == Wanted && noGivenNewtypeReprEqs tc1 inerts) + -- See Note [Decomposing newtype equalities] (EX2) {- Note [Use canEqFailure in canDecomposableTyConApp] @@ -1856,7 +1857,7 @@ Conclusion: decompose newtypes (at role R) only if there are no usable Givens. Conclusion: always unwrap newtypes before attempting to decompose them. This is done in can_eq_nc'. Of course, we can't unwrap if the data - constructor isn't in scope. See See Note [Unwrap newtypes first]. + constructor isn't in scope. See Note [Unwrap newtypes first]. * Incompleteness example (EX2) newtype Nt a = Mk Bool -- NB: a is not used in the RHS, @@ -1864,31 +1865,51 @@ Conclusion: decompose newtypes (at role R) only if there are no usable Givens. If we have [W] Nt alpha ~R Nt beta, we *don't* want to decompose to [W] alpha ~R beta, because it's possible that alpha and beta aren't - representationally equal. - - and maybe there is a Given (Nt t1 ~R Nt t2), just waiting to be used, if we - figure out (elsewhere) that alpha:=t1 and beta:=t2. This is somewhat - similar to the question of overlapping Givens for class constraints: see - Note [Instance and Given overlap] in GHC.Tc.Solver.Interact. + representationally equal. And maybe there is a Given (Nt t1 ~R Nt t2), + just waiting to be used, if we figure out (elsewhere) that alpha:=t1 + and beta:=t2. This is somewhat similar to the question of overlapping + Givens for class constraints: see Note [Instance and Given overlap] + in GHC.Tc.Solver.Interact. Conclusion: don't decompose [W] N s ~R N t, if there are any Given equalities that could later solve it. - But what does "any Given equalities that could later solve it" mean, precisely? - It must be a Given constraint that could turn into N s ~ N t. But that - could include [G] (a b) ~ (c d), or even just [G] c. But it'll definitely - be an CIrredCan. So we settle for having no CIrredCans at all, which is - conservative but safe. See noGivenIrreds and #22331. + But what precisely does "any Given equalities that could later solve it" mean? + + It must be a Given constraint that could turn into N s ~ N t. + That could /in principle/ include [G] (a b) ~ (c d), or even just [G] c. + But since the free vars of a Given are skolems, or at least untouchable + unification variables, it is extremely unlikely that such Givens + will "turn into" [G] N s ~ N t. + + Moreover, in #22908 we had + [G] f a ~R# a [W] Const (f a) a ~R# Const a a + where Const is a newtype. If we decomposed the newtype, we could solve. + Not-decomposing on the grounds that (f a ~R# a) might turn into + (Const (f a) a ~R# Const a a) seems a bit silly. + + The currently-implemented compromise is this: + + we decompose [W] N s ~R# N t unless there is a [G] N s' ~ N t' + + that is, a Given Irred equality with both sides headed with N. + See the call to noGivenNewtypeReprEqs in canTyConApp. + + This is still incomplete but only just, and there is no perfect answer. + See #22331 and #22908. + + We only look at Irreds. There could, just, be a CDictCan with some + un-expanded equality superclasses; but only in some very obscure + recursive-superclass situations. - Well not 100.0% safe. There could be a CDictCan with some un-expanded - superclasses; but only in some very obscure recursive-superclass - situations. + Now suppose we have [G] IO t1 ~R# IO t2, [W] IO Age ~R# IO Int, + where t1, t2 are not actually Age, Int. Then noGiveNewtypeReprEqs + will stop us decomposing the Wanted (IO is a newtype). But we + can /still/ win by unwrapping the newtype Age in the rewriter: + see Note [Unwrap newtypes first] -If there are no Irred Givens (which is quite common) then we will -successfuly decompose [W] (IO Age) ~R (IO Int), and solve it. But -that won't happen and [W] (IO Age) ~R (IO Int) will be stuck. -We /could/, however, be a bit more aggressive about decomposition; -see Note [Decomposing newtypes a bit more aggressively]. + Yet another approach (!) is desribed in + Note [Decomposing newtypes a bit more aggressively]. Remember: decomposing Wanteds is always /sound/. This Note is only about /completeness/. @@ -1896,7 +1917,8 @@ only about /completeness/. Note [Decomposing newtypes a bit more aggressively] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ IMPORTANT: the ideas in this Note are *not* implemented. Instead, the -current approach is detailed in Note [Unwrap newtypes first]. +current approach is detailed in Note [Decomposing newtype equalities] +and Note [Unwrap newtypes first]. For more details about the ideas in this Note see * GHC propoosal: https://github.com/ghc-proposals/ghc-proposals/pull/549 * issue #22441 ===================================== compiler/GHC/Tc/Solver/InertSet.hs ===================================== @@ -21,7 +21,7 @@ module GHC.Tc.Solver.InertSet ( addInertItem, noMatchableGivenDicts, - noGivenIrreds, + noGivenNewtypeReprEqs, mightEqualLater, prohibitedSuperClassSolve, @@ -1537,9 +1537,22 @@ isOuterTyVar tclvl tv -- becomes "outer" even though its level numbers says it isn't. | otherwise = False -- Coercion variables; doesn't much matter -noGivenIrreds :: InertSet -> Bool -noGivenIrreds (IS { inert_cans = inert_cans }) - = isEmptyBag (inert_irreds inert_cans) +noGivenNewtypeReprEqs :: TyCon -> InertSet -> Bool +-- True <=> there is no Irred looking like (N tys1 ~ N tys2) +-- See Note [Decomposing newtype equalities] (EX2) in GHC.Tc.Solver.Canonical +-- This is the only call site. +noGivenNewtypeReprEqs tc inerts + = not (anyBag might_help (inert_irreds (inert_cans inerts))) + where + might_help ct + = case classifyPredType (ctPred ct) of + EqPred ReprEq t1 t2 + | Just (tc1,_) <- tcSplitTyConApp_maybe t1 + , tc == tc1 + , Just (tc2,_) <- tcSplitTyConApp_maybe t2 + , tc == tc2 + -> True + _ -> False -- | Returns True iff there are no Given constraints that might, -- potentially, match the given class consraint. This is used when checking to see if a ===================================== testsuite/driver/runtests.py ===================================== @@ -601,6 +601,7 @@ else: if args.junit: junit(t).write(args.junit) + args.junit.close() if config.only_report_hadrian_deps: print("WARNING - skipping all tests and only reporting required hadrian dependencies:", config.hadrian_deps) ===================================== testsuite/driver/testlib.py ===================================== @@ -1347,7 +1347,7 @@ def do_test(name: TestName, # if found and instead have the testsuite decide on what to do # with the output. def override_options(pre_cmd): - if config.verbose >= 5 and bool(re.match('\$make', pre_cmd, re.I)): + if config.verbose >= 5 and bool(re.match(r'\$make', pre_cmd, re.I)): return pre_cmd.replace(' -s' , '') \ .replace('--silent', '') \ .replace('--quiet' , '') @@ -1989,7 +1989,7 @@ def split_file(in_fn: Path, delimiter: str, out1_fn: Path, out2_fn: Path): with out1_fn.open('w', encoding='utf8', newline='') as out1: with out2_fn.open('w', encoding='utf8', newline='') as out2: line = infile.readline() - while re.sub('^\s*','',line) != delimiter and line != '': + while re.sub(r'^\s*','',line) != delimiter and line != '': out1.write(line) line = infile.readline() @@ -2399,20 +2399,20 @@ def normalise_errmsg(s: str) -> str: # warning message to get clean output. if config.msys: s = re.sub('Failed to remove file (.*); error= (.*)$', '', s) - s = re.sub('DeleteFile "(.+)": permission denied \(Access is denied\.\)(.*)$', '', s) + s = re.sub(r'DeleteFile "(.+)": permission denied \(Access is denied\.\)(.*)$', '', s) # filter out unsupported GNU_PROPERTY_TYPE (5), which is emitted by LLVM10 # and not understood by older binutils (ar, ranlib, ...) - s = modify_lines(s, lambda l: re.sub('^(.+)warning: (.+): unsupported GNU_PROPERTY_TYPE \(5\) type: 0xc000000(.*)$', '', l)) + s = modify_lines(s, lambda l: re.sub(r'^(.+)warning: (.+): unsupported GNU_PROPERTY_TYPE \(5\) type: 0xc000000(.*)$', '', l)) - s = re.sub('ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) + s = re.sub(r'ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) s = re.sub('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version','',s) # ignore superfluous dylibs passed to the linker. s = re.sub('ld: warning: .*, ignoring unexpected dylib file\n','',s) # ignore LLVM Version mismatch garbage; this will just break tests. s = re.sub('You are using an unsupported version of LLVM!.*\n','',s) - s = re.sub('Currently only [\.0-9]+ is supported. System LLVM version: [\.0-9]+.*\n','',s) - s = re.sub('We will try though\.\.\..*\n','',s) + s = re.sub('Currently only [\\.0-9]+ is supported. System LLVM version: [\\.0-9]+.*\n','',s) + s = re.sub('We will try though\\.\\.\\..*\n','',s) # ignore warning about strip invalidating signatures s = re.sub('.*strip: changes being made to the file will invalidate the code signature in.*\n','',s) # clang may warn about unused argument when used as assembler @@ -2475,8 +2475,8 @@ def normalise_slashes_( s: str ) -> str: return s def normalise_exe_( s: str ) -> str: - s = re.sub('\.exe', '', s) - s = re.sub('\.jsexe', '', s) + s = re.sub(r'\.exe', '', s) + s = re.sub(r'\.jsexe', '', s) return s def normalise_output( s: str ) -> str: @@ -2494,14 +2494,14 @@ def normalise_output( s: str ) -> str: # ghci outputs are pretty unstable with -fexternal-dynamic-refs, which is # requires for -fPIC s = re.sub(' -fexternal-dynamic-refs\n','',s) - s = re.sub('ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) + s = re.sub(r'ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s) s = re.sub('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version','',s) # ignore superfluous dylibs passed to the linker. s = re.sub('ld: warning: .*, ignoring unexpected dylib file\n','',s) # ignore LLVM Version mismatch garbage; this will just break tests. s = re.sub('You are using an unsupported version of LLVM!.*\n','',s) - s = re.sub('Currently only [\.0-9]+ is supported. System LLVM version: [\.0-9]+.*\n','',s) - s = re.sub('We will try though\.\.\..*\n','',s) + s = re.sub('Currently only [\\.0-9]+ is supported. System LLVM version: [\\.0-9]+.*\n','',s) + s = re.sub('We will try though\\.\\.\\..*\n','',s) # ignore warning about strip invalidating signatures s = re.sub('.*strip: changes being made to the file will invalidate the code signature in.*\n','',s) # clang may warn about unused argument when used as assembler ===================================== testsuite/tests/rename/should_compile/T22913.hs ===================================== @@ -0,0 +1,10 @@ +module T22913 where + +class FromSourceIO a where + fromSourceIO :: a +instance FromSourceIO (Maybe o) where + fromSourceIO = undefined + {-# SPECIALISE INLINE fromSourceIO :: Maybe o #-} + -- This SPECIALISE pragma caused a Core Lint error + -- due to incorrectly scoping the type variable 'o' from the instance header + -- over the SPECIALISE pragma. ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -199,3 +199,4 @@ test('T22513f', normal, compile, ['-Wterm-variable-capture']) test('T22513g', normal, compile, ['-Wterm-variable-capture']) test('T22513h', normal, compile, ['-Wterm-variable-capture']) test('T22513i', req_th, compile, ['-Wterm-variable-capture']) +test('T22913', normal, compile, ['']) ===================================== testsuite/tests/simplCore/should_compile/T21148.hs deleted ===================================== @@ -1,12 +0,0 @@ -module T211148 where - --- The point of this test is that f should get a (nested) --- CPR property, with a worker of type --- $wf :: Int# -> State# RealWorld -> (# State# RealWorld, Int# #) - -{-# NOINLINE f #-} --- The NOINLINE makes GHC do a worker/wrapper split --- even though f is small -f :: Int -> IO Int -f x = return $! sum [0..x] - ===================================== testsuite/tests/simplCore/should_compile/T21148.stderr deleted ===================================== @@ -1,126 +0,0 @@ - -==================== Tidy Core ==================== -Result size of Tidy Core - = {terms: 73, types: 80, coercions: 6, joins: 2/2} - --- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule4 :: GHC.Prim.Addr# -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] -T211148.$trModule4 = "main"# - --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule3 :: GHC.Types.TrName -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -T211148.$trModule3 = GHC.Types.TrNameS T211148.$trModule4 - --- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule2 :: GHC.Prim.Addr# -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] -T211148.$trModule2 = "T211148"# - --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule1 :: GHC.Types.TrName -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -T211148.$trModule1 = GHC.Types.TrNameS T211148.$trModule2 - --- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T211148.$trModule :: GHC.Types.Module -[GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -T211148.$trModule - = GHC.Types.Module T211148.$trModule3 T211148.$trModule1 - --- RHS size: {terms: 41, types: 35, coercions: 0, joins: 2/2} -T211148.$wf [InlPrag=NOINLINE] - :: GHC.Prim.Int# - -> GHC.Prim.State# GHC.Prim.RealWorld - -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #) -[GblId, Arity=2, Str=, Unf=OtherCon []] -T211148.$wf - = \ (ww_s179 :: GHC.Prim.Int#) - (eta_s17b [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld) -> - case GHC.Prim.># 0# ww_s179 of { - __DEFAULT -> - join { - exit_X0 [Dmd=SC(S,C(1,!P(L,L)))] - :: GHC.Prim.Int# - -> GHC.Prim.Int# - -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #) - [LclId[JoinId(2)(Nothing)], Arity=2, Str=] - exit_X0 (x_s16Z [OS=OneShot] :: GHC.Prim.Int#) - (ww1_s172 [OS=OneShot] :: GHC.Prim.Int#) - = (# eta_s17b, GHC.Prim.+# ww1_s172 x_s16Z #) } in - joinrec { - $wgo3_s175 [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,C(1,!P(L,L)))] - :: GHC.Prim.Int# - -> GHC.Prim.Int# - -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #) - [LclId[JoinId(2)(Nothing)], Arity=2, Str=, Unf=OtherCon []] - $wgo3_s175 (x_s16Z :: GHC.Prim.Int#) (ww1_s172 :: GHC.Prim.Int#) - = case GHC.Prim.==# x_s16Z ww_s179 of { - __DEFAULT -> - jump $wgo3_s175 - (GHC.Prim.+# x_s16Z 1#) (GHC.Prim.+# ww1_s172 x_s16Z); - 1# -> jump exit_X0 x_s16Z ww1_s172 - }; } in - jump $wgo3_s175 0# 0#; - 1# -> (# eta_s17b, 0# #) - } - --- RHS size: {terms: 14, types: 19, coercions: 0, joins: 0/0} -T211148.f1 [InlPrag=NOINLINE[final]] - :: Int - -> GHC.Prim.State# GHC.Prim.RealWorld - -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #) -[GblId, - Arity=2, - Str=<1!P(L)>, - Cpr=1(, 1), - Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (x_s177 [Occ=Once1!] :: Int) - (eta_s17b [Occ=Once1, OS=OneShot] - :: GHC.Prim.State# GHC.Prim.RealWorld) -> - case x_s177 of { GHC.Types.I# ww_s179 [Occ=Once1] -> - case T211148.$wf ww_s179 eta_s17b of - { (# ww1_s17e [Occ=Once1], ww2_s17j [Occ=Once1] #) -> - (# ww1_s17e, GHC.Types.I# ww2_s17j #) - } - }}] -T211148.f1 - = \ (x_s177 :: Int) - (eta_s17b [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld) -> - case x_s177 of { GHC.Types.I# ww_s179 -> - case T211148.$wf ww_s179 eta_s17b of { (# ww1_s17e, ww2_s17j #) -> - (# ww1_s17e, GHC.Types.I# ww2_s17j #) - } - } - --- RHS size: {terms: 1, types: 0, coercions: 6, joins: 0/0} -f [InlPrag=NOINLINE[final]] :: Int -> IO Int -[GblId, - Arity=2, - Str=<1!P(L)>, - Cpr=1(, 1), - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}] -f = T211148.f1 - `cast` (_R %<'Many>_N ->_R Sym (GHC.Types.N:IO[0] _R) - :: (Int - -> GHC.Prim.State# GHC.Prim.RealWorld - -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)) - ~R# (Int -> IO Int)) - - - ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -429,7 +429,6 @@ test('T21763a', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) test('T22028', normal, compile, ['-O -ddump-rule-firings']) test('T22114', normal, compile, ['-O']) test('T21286', normal, multimod_compile, ['T21286', '-O -ddump-rule-firings']) -test('T21148', [grep_errmsg(r'Cpr=') ], compile, ['-O -ddump-simpl']) # One module, T21851.hs, has OPTIONS_GHC -ddump-simpl test('T21851', [grep_errmsg(r'case.*w\$sf') ], multimod_compile, ['T21851', '-O -dno-typeable-binds -dsuppress-uniques']) ===================================== testsuite/tests/stranal/should_compile/T21128.hs ===================================== @@ -2,10 +2,6 @@ module T21128 where import T21128a -{- This test originally had some unnecessary reboxing of y -in the hot path of $wtheresCrud. That reboxing should -not happen. -} - theresCrud :: Int -> Int -> Int theresCrud x y = go x where @@ -13,4 +9,3 @@ theresCrud x y = go x go 1 = index x y 1 go n = go (n-1) {-# NOINLINE theresCrud #-} - ===================================== testsuite/tests/stranal/should_compile/T21128.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 125, types: 68, coercions: 4, joins: 0/0} + = {terms: 137, types: 92, coercions: 4, joins: 0/0} lvl = "error"# @@ -29,11 +29,17 @@ lvl9 = SrcLoc lvl2 lvl3 lvl5 lvl6 lvl7 lvl6 lvl8 lvl10 = PushCallStack lvl1 lvl9 EmptyCallStack +$windexError + = \ @a @b ww eta eta1 eta2 -> + error + (lvl10 `cast` :: CallStack ~R# (?callStack::CallStack)) + (++ (ww eta) (++ (ww eta1) (ww eta2))) + indexError = \ @a @b $dShow eta eta1 eta2 -> - error - (lvl10 `cast` :: ...) - (++ (show $dShow eta) (++ (show $dShow eta1) (show $dShow eta2))) + case $dShow of { C:Show ww ww1 ww2 -> + $windexError ww1 eta eta1 eta2 + } $trModule3 = TrNameS $trModule4 @@ -42,7 +48,8 @@ $trModule1 = TrNameS $trModule2 $trModule = Module $trModule3 $trModule1 $wlvl - = \ ww ww1 ww2 -> indexError $fShowInt (I# ww2) (I# ww1) (I# ww) + = \ ww ww1 ww2 -> + $windexError $fShowInt_$cshow (I# ww2) (I# ww1) (I# ww) index = \ l u i -> @@ -66,7 +73,7 @@ index ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 108, types: 46, coercions: 0, joins: 3/3} + = {terms: 108, types: 47, coercions: 0, joins: 3/4} $trModule4 = "main"# @@ -82,34 +89,35 @@ i = I# 1# l = I# 0# -lvl = \ x ww -> indexError $fShowInt x (I# ww) i +lvl = \ y -> $windexError $fShowInt_$cshow l y l -lvl1 = \ ww -> indexError $fShowInt l (I# ww) l +lvl1 = \ ww y -> $windexError $fShowInt_$cshow (I# ww) y i $wtheresCrud = \ ww ww1 -> + let { y = I# ww1 } in join { - exit - = case <# 0# ww1 of { - __DEFAULT -> case lvl1 ww1 of wild { }; - 1# -> 0# - } } in - join { - exit1 + lvl2 = case <=# ww 1# of { - __DEFAULT -> case lvl (I# ww) ww1 of wild { }; + __DEFAULT -> case lvl1 ww y of wild { }; 1# -> case <# 1# ww1 of { - __DEFAULT -> case lvl (I# ww) ww1 of wild { }; + __DEFAULT -> case lvl1 ww y of wild { }; 1# -> -# 1# ww } } } in + join { + lvl3 + = case <# 0# ww1 of { + __DEFAULT -> case lvl y of wild { }; + 1# -> 0# + } } in joinrec { $wgo ww2 = case ww2 of wild { __DEFAULT -> jump $wgo (-# wild 1#); - 0# -> jump exit; - 1# -> jump exit1 + 0# -> jump lvl3; + 1# -> jump lvl2 }; } in jump $wgo ww View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2b7bb2defad8e4d9ceb58f38db240b0e6f3967c3...c8d18d0a3ecae86a97573e42d16121cf0c882d7b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2b7bb2defad8e4d9ceb58f38db240b0e6f3967c3...c8d18d0a3ecae86a97573e42d16121cf0c882d7b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 23:14:29 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 08 Feb 2023 18:14:29 -0500 Subject: [Git][ghc/ghc][wip/T22924] Simplify the decompose-newtype test further Message-ID: <63e42cd5bf173_2b039a5274c180824@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22924 at Glasgow Haskell Compiler / GHC Commits: 7b2a7e0d by Simon Peyton Jones at 2023-02-08T23:15:14+00:00 Simplify the decompose-newtype test further - - - - - 1 changed file: - compiler/GHC/Tc/Solver/Canonical.hs Changes: ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -1650,7 +1650,8 @@ canTyConApp rewritten ev eq_rel tc1 tys1 tc2 tys2 -- Moreover isInjectiveTyCon is True for Representational -- for algebraic data types. So we are down to newtypes -- and data families. - ctEvFlavour ev == Wanted && noGivenNewtypeReprEqs tc1 inerts) + ctEvFlavour ev == Wanted + -- COMMENTING OUT; see !22924: && noGivenNewtypeReprEqs tc1 inerts) -- See Note [Decomposing newtype equalities] (EX2) {- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7b2a7e0d52f0814d8c8edf6e6c9caf080f4502f9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7b2a7e0d52f0814d8c8edf6e6c9caf080f4502f9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 23:17:19 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 08 Feb 2023 18:17:19 -0500 Subject: [Git][ghc/ghc][wip/T22924] Add test for #22924 Message-ID: <63e42d7fe1af0_2b039a52710181434@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22924 at Glasgow Haskell Compiler / GHC Commits: 88314953 by Simon Peyton Jones at 2023-02-08T23:18:02+00:00 Add test for #22924 - - - - - 2 changed files: - + testsuite/tests/typecheck/should_compile/T22924.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== testsuite/tests/typecheck/should_compile/T22924.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE FlexibleInstances #-} +module G where + +import Data.Functor.Const( Const ) +import Data.Coerce + +f :: Coercible (f a) a => Const a () -> Const (f a) () +f = coerce + ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -857,3 +857,4 @@ test('T22647', normal, compile, ['']) test('T19577', normal, compile, ['']) test('T22383', normal, compile, ['']) test('T21501', normal, compile, ['']) +test('T22924', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8831495325a680e9dc23fbc9e8037ee21557a91b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8831495325a680e9dc23fbc9e8037ee21557a91b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 23:42:35 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 08 Feb 2023 18:42:35 -0500 Subject: [Git][ghc/ghc][master] 2 commits: testsuite: remove config.use_threads Message-ID: <63e4336b3a96f_2b039a527ec19133b@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - 4 changed files: - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/driver/testutil.py Changes: ===================================== testsuite/driver/runtests.py ===================================== @@ -26,7 +26,9 @@ from pathlib import Path # So we import it here first, so that the testsuite doesn't appear to fail. import subprocess -from testutil import getStdout, Watcher, str_warn, str_info, print_table, shorten_metric_name +from concurrent.futures import ThreadPoolExecutor + +from testutil import getStdout, str_warn, str_info, print_table, shorten_metric_name from testglobals import getConfig, ghc_env, getTestRun, TestConfig, \ TestOptions, brokens, PerfMetric from my_typing import TestName @@ -151,7 +153,6 @@ config.broken_tests |= {TestName(t) for t in args.broken_test} if args.threads: config.threads = args.threads - config.use_threads = True if args.verbose is not None: config.verbose = args.verbose @@ -481,26 +482,28 @@ if config.list_broken: print('WARNING:', len(t.framework_failures), 'framework failures!') print('') else: - # completion watcher - watcher = Watcher(len(parallelTests)) - # Now run all the tests try: - for oneTest in parallelTests: - if stopping(): - break - oneTest(watcher) + with ThreadPoolExecutor(max_workers=config.threads) as executor: + for oneTest in parallelTests: + if stopping(): + break + oneTest(executor) - # wait for parallel tests to finish - if not stopping(): - watcher.wait() + # wait for parallel tests to finish + if not stopping(): + executor.shutdown(wait=True) # Run the following tests purely sequential - config.use_threads = False - for oneTest in aloneTests: - if stopping(): - break - oneTest(watcher) + with ThreadPoolExecutor(max_workers=1) as executor: + for oneTest in aloneTests: + if stopping(): + break + oneTest(executor) + + if not stopping(): + executor.shutdown(wait=True) + except KeyboardInterrupt: pass ===================================== testsuite/driver/testglobals.py ===================================== @@ -177,7 +177,6 @@ class TestConfig: # threads self.threads = 1 - self.use_threads = False # tests which should be considered to be broken during this testsuite # run. ===================================== testsuite/driver/testlib.py ===================================== @@ -36,10 +36,7 @@ from my_typing import * from threading import Timer from collections import OrderedDict -global pool_sema -if config.use_threads: - import threading - pool_sema = threading.BoundedSemaphore(value=config.threads) +import threading global wantToStop wantToStop = False @@ -84,12 +81,7 @@ def get_all_ways() -> Set[WayName]: # testdir_testopts after each test). global testopts_local -if config.use_threads: - testopts_local = threading.local() -else: - class TestOpts_Local: - pass - testopts_local = TestOpts_Local() # type: ignore +testopts_local = threading.local() def getTestOpts() -> TestOptions: return testopts_local.x @@ -1020,16 +1012,8 @@ parallelTests = [] aloneTests = [] allTestNames = set([]) # type: Set[TestName] -def runTest(watcher, opts, name: TestName, func, args): - if config.use_threads: - pool_sema.acquire() - t = threading.Thread(target=test_common_thread, - name=name, - args=(watcher, name, opts, func, args)) - t.daemon = False - t.start() - else: - test_common_work(watcher, name, opts, func, args) +def runTest(executor, opts, name: TestName, func, args): + return executor.submit(test_common_work, name, opts, func, args) # name :: String # setup :: [TestOpt] -> IO () @@ -1067,20 +1051,13 @@ def test(name: TestName, if name in config.broken_tests: myTestOpts.expect = 'fail' - thisTest = lambda watcher: runTest(watcher, myTestOpts, name, func, args) + thisTest = lambda executor: runTest(executor, myTestOpts, name, func, args) if myTestOpts.alone: aloneTests.append(thisTest) else: parallelTests.append(thisTest) allTestNames.add(name) -if config.use_threads: - def test_common_thread(watcher, name, opts, func, args): - try: - test_common_work(watcher, name, opts, func, args) - finally: - pool_sema.release() - def get_package_cache_timestamp() -> float: if config.package_conf_cache_file is None: return 0.0 @@ -1094,8 +1071,7 @@ do_not_copy = ('.hi', '.o', '.dyn_hi' , '.dyn_o', '.out' ,'.hi-boot', '.o-boot') # 12112 -def test_common_work(watcher: testutil.Watcher, - name: TestName, opts, +def test_common_work(name: TestName, opts, func, args) -> None: try: t.total_tests += 1 @@ -1214,8 +1190,6 @@ def test_common_work(watcher: testutil.Watcher, except Exception as e: framework_fail(name, None, 'Unhandled exception: ' + str(e)) - finally: - watcher.notify() def do_test(name: TestName, way: WayName, ===================================== testsuite/driver/testutil.py ===================================== @@ -5,8 +5,6 @@ import tempfile from pathlib import Path, PurePath from term_color import Color, colored -import threading - from my_typing import * @@ -125,24 +123,6 @@ else: else: os.symlink(str(src), str(dst)) -class Watcher(object): - def __init__(self, count: int) -> None: - self.pool = count - self.evt = threading.Event() - self.sync_lock = threading.Lock() - if count <= 0: - self.evt.set() - - def wait(self): - self.evt.wait() - - def notify(self): - self.sync_lock.acquire() - self.pool -= 1 - if self.pool <= 0: - self.evt.set() - self.sync_lock.release() - def memoize(f): """ A decorator to memoize a nullary function. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7eac2468a726f217dd97c5e2884f6b552e8ef11d...ca6673e3cab496bbeed2ced47b40bcf1e0d0b3cd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7eac2468a726f217dd97c5e2884f6b552e8ef11d...ca6673e3cab496bbeed2ced47b40bcf1e0d0b3cd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 8 23:43:14 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 08 Feb 2023 18:43:14 -0500 Subject: [Git][ghc/ghc][master] EPA: Comment between module and where should be in header comments Message-ID: <63e4339251fc7_2b039a526e81966c1@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - 8 changed files: - compiler/GHC/Parser/Lexer.x - + testsuite/tests/ghc-api/exactprint/T22919.hs - + testsuite/tests/ghc-api/exactprint/T22919.stderr - testsuite/tests/ghc-api/exactprint/Test20239.stderr - testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr - testsuite/tests/ghc-api/exactprint/all.T - testsuite/tests/parser/should_compile/DumpParsedAstComments.hs - testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr Changes: ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -3700,11 +3700,13 @@ allocatePriorComments ss comment_q mheader_comments = cmp (L l _) = anchor l <= ss (newAnns,after) = partition cmp comment_q comment_q'= after - (prior_comments, decl_comments) = splitPriorComments ss newAnns + (prior_comments, decl_comments) + = case mheader_comments of + Strict.Nothing -> (reverse newAnns, []) + _ -> splitPriorComments ss newAnns in case mheader_comments of Strict.Nothing -> (Strict.Just prior_comments, comment_q', decl_comments) - -- Strict.Nothing -> (Strict.Just [], comment_q', newAnns) Strict.Just _ -> (mheader_comments, comment_q', reverse newAnns) allocateFinalComments ===================================== testsuite/tests/ghc-api/exactprint/T22919.hs ===================================== @@ -0,0 +1,2 @@ +module T22919 {- comment -} where +foo = 's' ===================================== testsuite/tests/ghc-api/exactprint/T22919.stderr ===================================== @@ -0,0 +1,116 @@ + +==================== Parser AST ==================== + +(L + { T22919.hs:1:1 } + (HsModule + (XModulePs + (EpAnn + (Anchor + { T22919.hs:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnModule (EpaSpan { T22919.hs:1:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { T22919.hs:1:29-33 }))] + (AnnList + (Nothing) + (Nothing) + (Nothing) + [] + []) + (Just + ((,) + { T22919.hs:3:1 } + { T22919.hs:2:7-9 }))) + (EpaCommentsBalanced + [(L + (Anchor + { T22919.hs:1:15-27 } + (UnchangedAnchor)) + (EpaComment + (EpaBlockComment + "{- comment -}") + { T22919.hs:1:8-13 }))] + [])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) + (Just + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:1:8-13 }) + {ModuleName: T22919})) + (Nothing) + [] + [(L + (SrcSpanAnn (EpAnn + (Anchor + { T22919.hs:2:1-9 } + (UnchangedAnchor)) + (AnnListItem + []) + (EpaComments + [])) { T22919.hs:2:1-9 }) + (ValD + (NoExtField) + (FunBind + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-3 }) + (Unqual + {OccName: foo})) + (MG + (FromSource) + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-9 }) + [(L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-9 }) + (Match + (EpAnn + (Anchor + { T22919.hs:2:1-9 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (FunRhs + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-3 }) + (Unqual + {OccName: foo})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (EpaComments + []) + [(L + (SrcSpanAnn + (EpAnnNotUsed) + { T22919.hs:2:5-9 }) + (GRHS + (EpAnn + (Anchor + { T22919.hs:2:5-9 } + (UnchangedAnchor)) + (GrhsAnn + (Nothing) + (AddEpAnn AnnEqual (EpaSpan { T22919.hs:2:5 }))) + (EpaComments + [])) + [] + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:7-9 }) + (HsLit + (EpAnn + (Anchor + { T22919.hs:2:7-9 } + (UnchangedAnchor)) + (NoEpAnns) + (EpaComments + [])) + (HsChar + (SourceText 's') + ('s'))))))] + (EmptyLocalBinds + (NoExtField)))))])))))])) ===================================== testsuite/tests/ghc-api/exactprint/Test20239.stderr ===================================== @@ -23,7 +23,14 @@ { Test20239.hs:8:1 } { Test20239.hs:7:34-63 }))) (EpaCommentsBalanced - [] + [(L + (Anchor + { Test20239.hs:3:1-28 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- | Leading Haddock Comment") + { Test20239.hs:1:18-22 }))] [(L (Anchor { Test20239.hs:7:34-63 } @@ -50,14 +57,7 @@ (AnnListItem []) (EpaComments - [(L - (Anchor - { Test20239.hs:3:1-28 } - (UnchangedAnchor)) - (EpaComment - (EpaLineComment - "-- | Leading Haddock Comment") - { Test20239.hs:1:18-22 }))])) { Test20239.hs:(4,1)-(6,86) }) + [])) { Test20239.hs:(4,1)-(6,86) }) (InstD (NoExtField) (DataFamInstD @@ -323,5 +323,5 @@ -Test20239.hs:4:15: error: [GHC-76037] +Test20239.hs:4:15: [GHC-76037] Not in scope: type constructor or class ‘Method’ ===================================== testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr ===================================== @@ -30,7 +30,15 @@ (EpaComment (EpaLineComment "-- leading comments") - { ZeroWidthSemi.hs:1:22-26 }))] + { ZeroWidthSemi.hs:1:22-26 })) + ,(L + (Anchor + { ZeroWidthSemi.hs:5:1-19 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- Function comment") + { ZeroWidthSemi.hs:3:1-19 }))] [(L (Anchor { ZeroWidthSemi.hs:8:1-58 } @@ -57,14 +65,7 @@ (AnnListItem []) (EpaComments - [(L - (Anchor - { ZeroWidthSemi.hs:5:1-19 } - (UnchangedAnchor)) - (EpaComment - (EpaLineComment - "-- Function comment") - { ZeroWidthSemi.hs:3:1-19 }))])) { ZeroWidthSemi.hs:6:1-5 }) + [])) { ZeroWidthSemi.hs:6:1-5 }) (ValD (NoExtField) (FunBind ===================================== testsuite/tests/ghc-api/exactprint/all.T ===================================== @@ -38,3 +38,4 @@ test('AddHiding1', ignore_stderr, makefile_test, ['AddHiding1']) test('AddHiding2', ignore_stderr, makefile_test, ['AddHiding2']) test('Test20239', normal, compile_fail, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments']) test('ZeroWidthSemi', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments']) +test('T22919', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments']) ===================================== testsuite/tests/parser/should_compile/DumpParsedAstComments.hs ===================================== @@ -4,6 +4,9 @@ -} module DumpParsedAstComments where +-- comment 1 for bar +-- comment 2 for bar +bar = 1 -- Other comment -- comment 1 for foo ===================================== testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr ===================================== @@ -21,8 +21,8 @@ []) (Just ((,) - { DumpParsedAstComments.hs:17:1 } - { DumpParsedAstComments.hs:16:17-23 }))) + { DumpParsedAstComments.hs:20:1 } + { DumpParsedAstComments.hs:19:17-23 }))) (EpaCommentsBalanced [(L (Anchor @@ -42,12 +42,20 @@ { DumpParsedAstComments.hs:1:1-28 })) ,(L (Anchor - { DumpParsedAstComments.hs:7:1-16 } + { DumpParsedAstComments.hs:7:1-20 } (UnchangedAnchor)) (EpaComment (EpaLineComment - "-- Other comment") - { DumpParsedAstComments.hs:5:30-34 }))] + "-- comment 1 for bar") + { DumpParsedAstComments.hs:5:30-34 })) + ,(L + (Anchor + { DumpParsedAstComments.hs:8:1-20 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- comment 2 for bar") + { DumpParsedAstComments.hs:7:1-20 }))] [])) (VirtualBraces (1)) @@ -62,55 +70,139 @@ [(L (SrcSpanAnn (EpAnn (Anchor - { DumpParsedAstComments.hs:(11,1)-(13,3) } + { DumpParsedAstComments.hs:9:1-7 } + (UnchangedAnchor)) + (AnnListItem + []) + (EpaComments + [])) { DumpParsedAstComments.hs:9:1-7 }) + (ValD + (NoExtField) + (FunBind + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-3 }) + (Unqual + {OccName: bar})) + (MG + (FromSource) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-7 }) + [(L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-7 }) + (Match + (EpAnn + (Anchor + { DumpParsedAstComments.hs:9:1-7 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (FunRhs + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-3 }) + (Unqual + {OccName: bar})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (EpaComments + []) + [(L + (SrcSpanAnn + (EpAnnNotUsed) + { DumpParsedAstComments.hs:9:5-7 }) + (GRHS + (EpAnn + (Anchor + { DumpParsedAstComments.hs:9:5-7 } + (UnchangedAnchor)) + (GrhsAnn + (Nothing) + (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:9:5 }))) + (EpaComments + [])) + [] + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:7 }) + (HsOverLit + (EpAnn + (Anchor + { DumpParsedAstComments.hs:9:7 } + (UnchangedAnchor)) + (NoEpAnns) + (EpaComments + [])) + (OverLit + (NoExtField) + (HsIntegral + (IL + (SourceText 1) + (False) + (1))))))))] + (EmptyLocalBinds + (NoExtField)))))]))))) + ,(L + (SrcSpanAnn (EpAnn + (Anchor + { DumpParsedAstComments.hs:(14,1)-(16,3) } (UnchangedAnchor)) (AnnListItem []) (EpaComments [(L (Anchor - { DumpParsedAstComments.hs:9:1-20 } + { DumpParsedAstComments.hs:10:1-16 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- Other comment") + { DumpParsedAstComments.hs:9:7 })) + ,(L + (Anchor + { DumpParsedAstComments.hs:12:1-20 } (UnchangedAnchor)) (EpaComment (EpaLineComment "-- comment 1 for foo") - { DumpParsedAstComments.hs:7:1-16 })) + { DumpParsedAstComments.hs:10:1-16 })) ,(L (Anchor - { DumpParsedAstComments.hs:10:1-20 } + { DumpParsedAstComments.hs:13:1-20 } (UnchangedAnchor)) (EpaComment (EpaLineComment "-- comment 2 for foo") - { DumpParsedAstComments.hs:9:1-20 - }))])) { DumpParsedAstComments.hs:(11,1)-(13,3) }) + { DumpParsedAstComments.hs:12:1-20 + }))])) { DumpParsedAstComments.hs:(14,1)-(16,3) }) (ValD (NoExtField) (FunBind (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:11:1-3 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:14:1-3 }) (Unqual {OccName: foo})) (MG (FromSource) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,1)-(13,3) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(14,1)-(16,3) }) [(L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,1)-(13,3) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(14,1)-(16,3) }) (Match (EpAnn (Anchor - { DumpParsedAstComments.hs:(11,1)-(13,3) } + { DumpParsedAstComments.hs:(14,1)-(16,3) } (UnchangedAnchor)) [] (EpaComments [])) (FunRhs (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:11:1-3 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:14:1-3 }) (Unqual {OccName: foo})) (Prefix) @@ -122,72 +214,72 @@ [(L (SrcSpanAnn (EpAnnNotUsed) - { DumpParsedAstComments.hs:(11,5)-(13,3) }) + { DumpParsedAstComments.hs:(14,5)-(16,3) }) (GRHS (EpAnn (Anchor - { DumpParsedAstComments.hs:(11,5)-(13,3) } + { DumpParsedAstComments.hs:(14,5)-(16,3) } (UnchangedAnchor)) (GrhsAnn (Nothing) - (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:11:5 }))) + (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:14:5 }))) (EpaComments [])) [] (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,7)-(13,3) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(14,7)-(16,3) }) (HsDo (EpAnn (Anchor - { DumpParsedAstComments.hs:(11,7)-(13,3) } + { DumpParsedAstComments.hs:(14,7)-(16,3) } (UnchangedAnchor)) (AnnList (Just (Anchor - { DumpParsedAstComments.hs:13:3 } + { DumpParsedAstComments.hs:16:3 } (UnchangedAnchor))) (Nothing) (Nothing) - [(AddEpAnn AnnDo (EpaSpan { DumpParsedAstComments.hs:11:7-8 }))] + [(AddEpAnn AnnDo (EpaSpan { DumpParsedAstComments.hs:14:7-8 }))] []) (EpaComments [(L (Anchor - { DumpParsedAstComments.hs:12:3-19 } + { DumpParsedAstComments.hs:15:3-19 } (UnchangedAnchor)) (EpaComment (EpaLineComment "-- normal comment") - { DumpParsedAstComments.hs:11:7-8 }))])) + { DumpParsedAstComments.hs:14:7-8 }))])) (DoExpr (Nothing)) (L (SrcSpanAnn (EpAnn (Anchor - { DumpParsedAstComments.hs:13:3 } + { DumpParsedAstComments.hs:16:3 } (UnchangedAnchor)) (AnnList (Just (Anchor - { DumpParsedAstComments.hs:13:3 } + { DumpParsedAstComments.hs:16:3 } (UnchangedAnchor))) (Nothing) (Nothing) [] []) (EpaComments - [])) { DumpParsedAstComments.hs:13:3 }) + [])) { DumpParsedAstComments.hs:16:3 }) [(L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:13:3 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:3 }) (BodyStmt (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:13:3 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:3 }) (HsOverLit (EpAnn (Anchor - { DumpParsedAstComments.hs:13:3 } + { DumpParsedAstComments.hs:16:3 } (UnchangedAnchor)) (NoEpAnns) (EpaComments @@ -206,45 +298,45 @@ ,(L (SrcSpanAnn (EpAnn (Anchor - { DumpParsedAstComments.hs:16:1-23 } + { DumpParsedAstComments.hs:19:1-23 } (UnchangedAnchor)) (AnnListItem []) (EpaComments [(L (Anchor - { DumpParsedAstComments.hs:15:1-20 } + { DumpParsedAstComments.hs:18:1-20 } (UnchangedAnchor)) (EpaComment (EpaLineComment "-- | Haddock comment") - { DumpParsedAstComments.hs:13:3 - }))])) { DumpParsedAstComments.hs:16:1-23 }) + { DumpParsedAstComments.hs:16:3 + }))])) { DumpParsedAstComments.hs:19:1-23 }) (ValD (NoExtField) (FunBind (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-4 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-4 }) (Unqual {OccName: main})) (MG (FromSource) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-23 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-23 }) [(L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-23 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-23 }) (Match (EpAnn (Anchor - { DumpParsedAstComments.hs:16:1-23 } + { DumpParsedAstComments.hs:19:1-23 } (UnchangedAnchor)) [] (EpaComments [])) (FunRhs (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-4 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-4 }) (Unqual {OccName: main})) (Prefix) @@ -256,42 +348,42 @@ [(L (SrcSpanAnn (EpAnnNotUsed) - { DumpParsedAstComments.hs:16:6-23 }) + { DumpParsedAstComments.hs:19:6-23 }) (GRHS (EpAnn (Anchor - { DumpParsedAstComments.hs:16:6-23 } + { DumpParsedAstComments.hs:19:6-23 } (UnchangedAnchor)) (GrhsAnn (Nothing) - (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:16:6 }))) + (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:19:6 }))) (EpaComments [])) [] (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-23 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:8-23 }) (HsApp (EpAnn (Anchor - { DumpParsedAstComments.hs:16:8-23 } + { DumpParsedAstComments.hs:19:8-23 } (UnchangedAnchor)) (NoEpAnns) (EpaComments [])) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-15 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:8-15 }) (HsVar (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-15 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:8-15 }) (Unqual {OccName: putStrLn})))) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:17-23 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:17-23 }) (HsLit (EpAnn (Anchor - { DumpParsedAstComments.hs:16:17-23 } + { DumpParsedAstComments.hs:19:17-23 } (UnchangedAnchor)) (NoEpAnns) (EpaComments View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f22cce70dc7b9da191a023a9677eaea491bb2688 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f22cce70dc7b9da191a023a9677eaea491bb2688 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 00:13:54 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 08 Feb 2023 19:13:54 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: testsuite: remove config.use_threads Message-ID: <63e43ac2c6800_2b039a526e820612f@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - 8dc22c6a by Josh Meredith at 2023-02-08T19:13:38-05:00 JS generated refs: update testsuite conditions - - - - - e754f617 by sheaf at 2023-02-08T19:13:40-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - 18 changed files: - compiler/GHC/Parser/Lexer.x - libraries/transformers - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/driver/testutil.py - testsuite/tests/driver/T1959/test.T - testsuite/tests/ffi/should_run/all.T - + testsuite/tests/ghc-api/exactprint/T22919.hs - + testsuite/tests/ghc-api/exactprint/T22919.stderr - testsuite/tests/ghc-api/exactprint/Test20239.stderr - testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr - testsuite/tests/ghc-api/exactprint/all.T - testsuite/tests/parser/should_compile/DumpParsedAstComments.hs - testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr - testsuite/tests/rts/all.T - testsuite/tests/safeHaskell/check/pkg01/all.T - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -3700,11 +3700,13 @@ allocatePriorComments ss comment_q mheader_comments = cmp (L l _) = anchor l <= ss (newAnns,after) = partition cmp comment_q comment_q'= after - (prior_comments, decl_comments) = splitPriorComments ss newAnns + (prior_comments, decl_comments) + = case mheader_comments of + Strict.Nothing -> (reverse newAnns, []) + _ -> splitPriorComments ss newAnns in case mheader_comments of Strict.Nothing -> (Strict.Just prior_comments, comment_q', decl_comments) - -- Strict.Nothing -> (Strict.Just [], comment_q', newAnns) Strict.Just _ -> (mheader_comments, comment_q', reverse newAnns) allocateFinalComments ===================================== libraries/transformers ===================================== @@ -1 +1 @@ -Subproject commit ceff1dcd7893f7ab4abb6e66bcd248abd86c8886 +Subproject commit ef4fa181ebea77ac6997d392d1ef5a09524f06b2 ===================================== testsuite/driver/runtests.py ===================================== @@ -26,7 +26,9 @@ from pathlib import Path # So we import it here first, so that the testsuite doesn't appear to fail. import subprocess -from testutil import getStdout, Watcher, str_warn, str_info, print_table, shorten_metric_name +from concurrent.futures import ThreadPoolExecutor + +from testutil import getStdout, str_warn, str_info, print_table, shorten_metric_name from testglobals import getConfig, ghc_env, getTestRun, TestConfig, \ TestOptions, brokens, PerfMetric from my_typing import TestName @@ -151,7 +153,6 @@ config.broken_tests |= {TestName(t) for t in args.broken_test} if args.threads: config.threads = args.threads - config.use_threads = True if args.verbose is not None: config.verbose = args.verbose @@ -481,26 +482,28 @@ if config.list_broken: print('WARNING:', len(t.framework_failures), 'framework failures!') print('') else: - # completion watcher - watcher = Watcher(len(parallelTests)) - # Now run all the tests try: - for oneTest in parallelTests: - if stopping(): - break - oneTest(watcher) + with ThreadPoolExecutor(max_workers=config.threads) as executor: + for oneTest in parallelTests: + if stopping(): + break + oneTest(executor) - # wait for parallel tests to finish - if not stopping(): - watcher.wait() + # wait for parallel tests to finish + if not stopping(): + executor.shutdown(wait=True) # Run the following tests purely sequential - config.use_threads = False - for oneTest in aloneTests: - if stopping(): - break - oneTest(watcher) + with ThreadPoolExecutor(max_workers=1) as executor: + for oneTest in aloneTests: + if stopping(): + break + oneTest(executor) + + if not stopping(): + executor.shutdown(wait=True) + except KeyboardInterrupt: pass ===================================== testsuite/driver/testglobals.py ===================================== @@ -177,7 +177,6 @@ class TestConfig: # threads self.threads = 1 - self.use_threads = False # tests which should be considered to be broken during this testsuite # run. ===================================== testsuite/driver/testlib.py ===================================== @@ -36,10 +36,7 @@ from my_typing import * from threading import Timer from collections import OrderedDict -global pool_sema -if config.use_threads: - import threading - pool_sema = threading.BoundedSemaphore(value=config.threads) +import threading global wantToStop wantToStop = False @@ -84,12 +81,7 @@ def get_all_ways() -> Set[WayName]: # testdir_testopts after each test). global testopts_local -if config.use_threads: - testopts_local = threading.local() -else: - class TestOpts_Local: - pass - testopts_local = TestOpts_Local() # type: ignore +testopts_local = threading.local() def getTestOpts() -> TestOptions: return testopts_local.x @@ -1020,16 +1012,8 @@ parallelTests = [] aloneTests = [] allTestNames = set([]) # type: Set[TestName] -def runTest(watcher, opts, name: TestName, func, args): - if config.use_threads: - pool_sema.acquire() - t = threading.Thread(target=test_common_thread, - name=name, - args=(watcher, name, opts, func, args)) - t.daemon = False - t.start() - else: - test_common_work(watcher, name, opts, func, args) +def runTest(executor, opts, name: TestName, func, args): + return executor.submit(test_common_work, name, opts, func, args) # name :: String # setup :: [TestOpt] -> IO () @@ -1067,20 +1051,13 @@ def test(name: TestName, if name in config.broken_tests: myTestOpts.expect = 'fail' - thisTest = lambda watcher: runTest(watcher, myTestOpts, name, func, args) + thisTest = lambda executor: runTest(executor, myTestOpts, name, func, args) if myTestOpts.alone: aloneTests.append(thisTest) else: parallelTests.append(thisTest) allTestNames.add(name) -if config.use_threads: - def test_common_thread(watcher, name, opts, func, args): - try: - test_common_work(watcher, name, opts, func, args) - finally: - pool_sema.release() - def get_package_cache_timestamp() -> float: if config.package_conf_cache_file is None: return 0.0 @@ -1094,8 +1071,7 @@ do_not_copy = ('.hi', '.o', '.dyn_hi' , '.dyn_o', '.out' ,'.hi-boot', '.o-boot') # 12112 -def test_common_work(watcher: testutil.Watcher, - name: TestName, opts, +def test_common_work(name: TestName, opts, func, args) -> None: try: t.total_tests += 1 @@ -1214,8 +1190,6 @@ def test_common_work(watcher: testutil.Watcher, except Exception as e: framework_fail(name, None, 'Unhandled exception: ' + str(e)) - finally: - watcher.notify() def do_test(name: TestName, way: WayName, ===================================== testsuite/driver/testutil.py ===================================== @@ -5,8 +5,6 @@ import tempfile from pathlib import Path, PurePath from term_color import Color, colored -import threading - from my_typing import * @@ -125,24 +123,6 @@ else: else: os.symlink(str(src), str(dst)) -class Watcher(object): - def __init__(self, count: int) -> None: - self.pool = count - self.evt = threading.Event() - self.sync_lock = threading.Lock() - if count <= 0: - self.evt.set() - - def wait(self): - self.evt.wait() - - def notify(self): - self.sync_lock.acquire() - self.pool -= 1 - if self.pool <= 0: - self.evt.set() - self.sync_lock.release() - def memoize(f): """ A decorator to memoize a nullary function. ===================================== testsuite/tests/driver/T1959/test.T ===================================== @@ -1 +1 @@ -test('T1959', [extra_files(['B.hs', 'C.hs', 'D.hs', 'E1.hs', 'E2.hs']), js_broken(22261)], makefile_test, ['dotest']) +test('T1959', [extra_files(['B.hs', 'C.hs', 'D.hs', 'E1.hs', 'E2.hs']), js_broken(22374)], makefile_test, ['dotest']) ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -167,10 +167,10 @@ test('T5594', [ omit_ways(['ghci']), ], compile_and_run, ['T5594_c.c -no-hs-main']) -test('Capi_Ctype_001', [extra_files(['Capi_Ctype_A_001.hsc', 'capi_ctype_001.h', 'capi_ctype_001_c.c']), js_broken(22374)], +test('Capi_Ctype_001', [extra_files(['Capi_Ctype_A_001.hsc', 'capi_ctype_001.h', 'capi_ctype_001_c.c']), req_c], makefile_test, ['Capi_Ctype_001']) -test('Capi_Ctype_002', [extra_files(['Capi_Ctype_A_002.hsc', 'capi_ctype_002_A.h', 'capi_ctype_002_B.h']), js_broken(22374)], +test('Capi_Ctype_002', [extra_files(['Capi_Ctype_A_002.hsc', 'capi_ctype_002_A.h', 'capi_ctype_002_B.h']), req_c], makefile_test, ['Capi_Ctype_002']) test('ffi_parsing_001', [omit_ways(['ghci']), req_c], compile_and_run, ===================================== testsuite/tests/ghc-api/exactprint/T22919.hs ===================================== @@ -0,0 +1,2 @@ +module T22919 {- comment -} where +foo = 's' ===================================== testsuite/tests/ghc-api/exactprint/T22919.stderr ===================================== @@ -0,0 +1,116 @@ + +==================== Parser AST ==================== + +(L + { T22919.hs:1:1 } + (HsModule + (XModulePs + (EpAnn + (Anchor + { T22919.hs:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnModule (EpaSpan { T22919.hs:1:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { T22919.hs:1:29-33 }))] + (AnnList + (Nothing) + (Nothing) + (Nothing) + [] + []) + (Just + ((,) + { T22919.hs:3:1 } + { T22919.hs:2:7-9 }))) + (EpaCommentsBalanced + [(L + (Anchor + { T22919.hs:1:15-27 } + (UnchangedAnchor)) + (EpaComment + (EpaBlockComment + "{- comment -}") + { T22919.hs:1:8-13 }))] + [])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) + (Just + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:1:8-13 }) + {ModuleName: T22919})) + (Nothing) + [] + [(L + (SrcSpanAnn (EpAnn + (Anchor + { T22919.hs:2:1-9 } + (UnchangedAnchor)) + (AnnListItem + []) + (EpaComments + [])) { T22919.hs:2:1-9 }) + (ValD + (NoExtField) + (FunBind + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-3 }) + (Unqual + {OccName: foo})) + (MG + (FromSource) + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-9 }) + [(L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-9 }) + (Match + (EpAnn + (Anchor + { T22919.hs:2:1-9 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (FunRhs + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-3 }) + (Unqual + {OccName: foo})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (EpaComments + []) + [(L + (SrcSpanAnn + (EpAnnNotUsed) + { T22919.hs:2:5-9 }) + (GRHS + (EpAnn + (Anchor + { T22919.hs:2:5-9 } + (UnchangedAnchor)) + (GrhsAnn + (Nothing) + (AddEpAnn AnnEqual (EpaSpan { T22919.hs:2:5 }))) + (EpaComments + [])) + [] + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:7-9 }) + (HsLit + (EpAnn + (Anchor + { T22919.hs:2:7-9 } + (UnchangedAnchor)) + (NoEpAnns) + (EpaComments + [])) + (HsChar + (SourceText 's') + ('s'))))))] + (EmptyLocalBinds + (NoExtField)))))])))))])) ===================================== testsuite/tests/ghc-api/exactprint/Test20239.stderr ===================================== @@ -23,7 +23,14 @@ { Test20239.hs:8:1 } { Test20239.hs:7:34-63 }))) (EpaCommentsBalanced - [] + [(L + (Anchor + { Test20239.hs:3:1-28 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- | Leading Haddock Comment") + { Test20239.hs:1:18-22 }))] [(L (Anchor { Test20239.hs:7:34-63 } @@ -50,14 +57,7 @@ (AnnListItem []) (EpaComments - [(L - (Anchor - { Test20239.hs:3:1-28 } - (UnchangedAnchor)) - (EpaComment - (EpaLineComment - "-- | Leading Haddock Comment") - { Test20239.hs:1:18-22 }))])) { Test20239.hs:(4,1)-(6,86) }) + [])) { Test20239.hs:(4,1)-(6,86) }) (InstD (NoExtField) (DataFamInstD @@ -323,5 +323,5 @@ -Test20239.hs:4:15: error: [GHC-76037] +Test20239.hs:4:15: [GHC-76037] Not in scope: type constructor or class ‘Method’ ===================================== testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr ===================================== @@ -30,7 +30,15 @@ (EpaComment (EpaLineComment "-- leading comments") - { ZeroWidthSemi.hs:1:22-26 }))] + { ZeroWidthSemi.hs:1:22-26 })) + ,(L + (Anchor + { ZeroWidthSemi.hs:5:1-19 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- Function comment") + { ZeroWidthSemi.hs:3:1-19 }))] [(L (Anchor { ZeroWidthSemi.hs:8:1-58 } @@ -57,14 +65,7 @@ (AnnListItem []) (EpaComments - [(L - (Anchor - { ZeroWidthSemi.hs:5:1-19 } - (UnchangedAnchor)) - (EpaComment - (EpaLineComment - "-- Function comment") - { ZeroWidthSemi.hs:3:1-19 }))])) { ZeroWidthSemi.hs:6:1-5 }) + [])) { ZeroWidthSemi.hs:6:1-5 }) (ValD (NoExtField) (FunBind ===================================== testsuite/tests/ghc-api/exactprint/all.T ===================================== @@ -38,3 +38,4 @@ test('AddHiding1', ignore_stderr, makefile_test, ['AddHiding1']) test('AddHiding2', ignore_stderr, makefile_test, ['AddHiding2']) test('Test20239', normal, compile_fail, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments']) test('ZeroWidthSemi', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments']) +test('T22919', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments']) ===================================== testsuite/tests/parser/should_compile/DumpParsedAstComments.hs ===================================== @@ -4,6 +4,9 @@ -} module DumpParsedAstComments where +-- comment 1 for bar +-- comment 2 for bar +bar = 1 -- Other comment -- comment 1 for foo ===================================== testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr ===================================== @@ -21,8 +21,8 @@ []) (Just ((,) - { DumpParsedAstComments.hs:17:1 } - { DumpParsedAstComments.hs:16:17-23 }))) + { DumpParsedAstComments.hs:20:1 } + { DumpParsedAstComments.hs:19:17-23 }))) (EpaCommentsBalanced [(L (Anchor @@ -42,12 +42,20 @@ { DumpParsedAstComments.hs:1:1-28 })) ,(L (Anchor - { DumpParsedAstComments.hs:7:1-16 } + { DumpParsedAstComments.hs:7:1-20 } (UnchangedAnchor)) (EpaComment (EpaLineComment - "-- Other comment") - { DumpParsedAstComments.hs:5:30-34 }))] + "-- comment 1 for bar") + { DumpParsedAstComments.hs:5:30-34 })) + ,(L + (Anchor + { DumpParsedAstComments.hs:8:1-20 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- comment 2 for bar") + { DumpParsedAstComments.hs:7:1-20 }))] [])) (VirtualBraces (1)) @@ -62,55 +70,139 @@ [(L (SrcSpanAnn (EpAnn (Anchor - { DumpParsedAstComments.hs:(11,1)-(13,3) } + { DumpParsedAstComments.hs:9:1-7 } + (UnchangedAnchor)) + (AnnListItem + []) + (EpaComments + [])) { DumpParsedAstComments.hs:9:1-7 }) + (ValD + (NoExtField) + (FunBind + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-3 }) + (Unqual + {OccName: bar})) + (MG + (FromSource) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-7 }) + [(L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-7 }) + (Match + (EpAnn + (Anchor + { DumpParsedAstComments.hs:9:1-7 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (FunRhs + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-3 }) + (Unqual + {OccName: bar})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (EpaComments + []) + [(L + (SrcSpanAnn + (EpAnnNotUsed) + { DumpParsedAstComments.hs:9:5-7 }) + (GRHS + (EpAnn + (Anchor + { DumpParsedAstComments.hs:9:5-7 } + (UnchangedAnchor)) + (GrhsAnn + (Nothing) + (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:9:5 }))) + (EpaComments + [])) + [] + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:7 }) + (HsOverLit + (EpAnn + (Anchor + { DumpParsedAstComments.hs:9:7 } + (UnchangedAnchor)) + (NoEpAnns) + (EpaComments + [])) + (OverLit + (NoExtField) + (HsIntegral + (IL + (SourceText 1) + (False) + (1))))))))] + (EmptyLocalBinds + (NoExtField)))))]))))) + ,(L + (SrcSpanAnn (EpAnn + (Anchor + { DumpParsedAstComments.hs:(14,1)-(16,3) } (UnchangedAnchor)) (AnnListItem []) (EpaComments [(L (Anchor - { DumpParsedAstComments.hs:9:1-20 } + { DumpParsedAstComments.hs:10:1-16 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- Other comment") + { DumpParsedAstComments.hs:9:7 })) + ,(L + (Anchor + { DumpParsedAstComments.hs:12:1-20 } (UnchangedAnchor)) (EpaComment (EpaLineComment "-- comment 1 for foo") - { DumpParsedAstComments.hs:7:1-16 })) + { DumpParsedAstComments.hs:10:1-16 })) ,(L (Anchor - { DumpParsedAstComments.hs:10:1-20 } + { DumpParsedAstComments.hs:13:1-20 } (UnchangedAnchor)) (EpaComment (EpaLineComment "-- comment 2 for foo") - { DumpParsedAstComments.hs:9:1-20 - }))])) { DumpParsedAstComments.hs:(11,1)-(13,3) }) + { DumpParsedAstComments.hs:12:1-20 + }))])) { DumpParsedAstComments.hs:(14,1)-(16,3) }) (ValD (NoExtField) (FunBind (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:11:1-3 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:14:1-3 }) (Unqual {OccName: foo})) (MG (FromSource) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,1)-(13,3) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(14,1)-(16,3) }) [(L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,1)-(13,3) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(14,1)-(16,3) }) (Match (EpAnn (Anchor - { DumpParsedAstComments.hs:(11,1)-(13,3) } + { DumpParsedAstComments.hs:(14,1)-(16,3) } (UnchangedAnchor)) [] (EpaComments [])) (FunRhs (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:11:1-3 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:14:1-3 }) (Unqual {OccName: foo})) (Prefix) @@ -122,72 +214,72 @@ [(L (SrcSpanAnn (EpAnnNotUsed) - { DumpParsedAstComments.hs:(11,5)-(13,3) }) + { DumpParsedAstComments.hs:(14,5)-(16,3) }) (GRHS (EpAnn (Anchor - { DumpParsedAstComments.hs:(11,5)-(13,3) } + { DumpParsedAstComments.hs:(14,5)-(16,3) } (UnchangedAnchor)) (GrhsAnn (Nothing) - (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:11:5 }))) + (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:14:5 }))) (EpaComments [])) [] (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,7)-(13,3) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(14,7)-(16,3) }) (HsDo (EpAnn (Anchor - { DumpParsedAstComments.hs:(11,7)-(13,3) } + { DumpParsedAstComments.hs:(14,7)-(16,3) } (UnchangedAnchor)) (AnnList (Just (Anchor - { DumpParsedAstComments.hs:13:3 } + { DumpParsedAstComments.hs:16:3 } (UnchangedAnchor))) (Nothing) (Nothing) - [(AddEpAnn AnnDo (EpaSpan { DumpParsedAstComments.hs:11:7-8 }))] + [(AddEpAnn AnnDo (EpaSpan { DumpParsedAstComments.hs:14:7-8 }))] []) (EpaComments [(L (Anchor - { DumpParsedAstComments.hs:12:3-19 } + { DumpParsedAstComments.hs:15:3-19 } (UnchangedAnchor)) (EpaComment (EpaLineComment "-- normal comment") - { DumpParsedAstComments.hs:11:7-8 }))])) + { DumpParsedAstComments.hs:14:7-8 }))])) (DoExpr (Nothing)) (L (SrcSpanAnn (EpAnn (Anchor - { DumpParsedAstComments.hs:13:3 } + { DumpParsedAstComments.hs:16:3 } (UnchangedAnchor)) (AnnList (Just (Anchor - { DumpParsedAstComments.hs:13:3 } + { DumpParsedAstComments.hs:16:3 } (UnchangedAnchor))) (Nothing) (Nothing) [] []) (EpaComments - [])) { DumpParsedAstComments.hs:13:3 }) + [])) { DumpParsedAstComments.hs:16:3 }) [(L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:13:3 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:3 }) (BodyStmt (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:13:3 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:3 }) (HsOverLit (EpAnn (Anchor - { DumpParsedAstComments.hs:13:3 } + { DumpParsedAstComments.hs:16:3 } (UnchangedAnchor)) (NoEpAnns) (EpaComments @@ -206,45 +298,45 @@ ,(L (SrcSpanAnn (EpAnn (Anchor - { DumpParsedAstComments.hs:16:1-23 } + { DumpParsedAstComments.hs:19:1-23 } (UnchangedAnchor)) (AnnListItem []) (EpaComments [(L (Anchor - { DumpParsedAstComments.hs:15:1-20 } + { DumpParsedAstComments.hs:18:1-20 } (UnchangedAnchor)) (EpaComment (EpaLineComment "-- | Haddock comment") - { DumpParsedAstComments.hs:13:3 - }))])) { DumpParsedAstComments.hs:16:1-23 }) + { DumpParsedAstComments.hs:16:3 + }))])) { DumpParsedAstComments.hs:19:1-23 }) (ValD (NoExtField) (FunBind (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-4 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-4 }) (Unqual {OccName: main})) (MG (FromSource) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-23 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-23 }) [(L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-23 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-23 }) (Match (EpAnn (Anchor - { DumpParsedAstComments.hs:16:1-23 } + { DumpParsedAstComments.hs:19:1-23 } (UnchangedAnchor)) [] (EpaComments [])) (FunRhs (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-4 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-4 }) (Unqual {OccName: main})) (Prefix) @@ -256,42 +348,42 @@ [(L (SrcSpanAnn (EpAnnNotUsed) - { DumpParsedAstComments.hs:16:6-23 }) + { DumpParsedAstComments.hs:19:6-23 }) (GRHS (EpAnn (Anchor - { DumpParsedAstComments.hs:16:6-23 } + { DumpParsedAstComments.hs:19:6-23 } (UnchangedAnchor)) (GrhsAnn (Nothing) - (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:16:6 }))) + (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:19:6 }))) (EpaComments [])) [] (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-23 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:8-23 }) (HsApp (EpAnn (Anchor - { DumpParsedAstComments.hs:16:8-23 } + { DumpParsedAstComments.hs:19:8-23 } (UnchangedAnchor)) (NoEpAnns) (EpaComments [])) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-15 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:8-15 }) (HsVar (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-15 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:8-15 }) (Unqual {OccName: putStrLn})))) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:17-23 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:17-23 }) (HsLit (EpAnn (Anchor - { DumpParsedAstComments.hs:16:17-23 } + { DumpParsedAstComments.hs:19:17-23 } (UnchangedAnchor)) (NoEpAnns) (EpaComments ===================================== testsuite/tests/rts/all.T ===================================== @@ -258,7 +258,7 @@ test('T6006', [ omit_ways(prof_ways + ['ghci']), # needs it. compile_and_run, ['T6006_c.c -no-hs-main']) -test('T7037', js_broken(22374), makefile_test, ['T7037']) +test('T7037', req_c, makefile_test, ['T7037']) test('T7087', exit_code(1), compile_and_run, ['']) test('T7160', [ omit_ways(['nonmoving_thr', 'nonmoving_thr_ghc']) ===================================== testsuite/tests/safeHaskell/check/pkg01/all.T ===================================== @@ -32,7 +32,7 @@ test('safePkg01', normalise_version("array", "ghc-bignum", "bytestring", "base", "deepseq", "ghc-prim"), normalise_fun(normalise_errmsg), - js_skip], + js_broken(22356)], run_command, ['$MAKE -s --no-print-directory safePkg01 ' + make_args]) # Fail since we enable package trust ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -152,7 +152,7 @@ test('T7702', # allocation done by the plugin... but a regression allocates > 90mb collect_compiler_stats('peak_megabytes_allocated',70), when(opsys('mingw32'), fragile_for(16799, ['normal'])), - js_skip + req_interp ], compile, ['-v0 -package-db T7702plugin/pkg.T7702/local.package.conf -fplugin T7702Plugin -package T7702plugin ' + config.plugin_way_flags]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d5b5c07c71ecb652d4594e5d6eddfdd28d4f060c...e754f617eacaa5cc231288c9caa7a73ef049bfc5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d5b5c07c71ecb652d4594e5d6eddfdd28d4f060c...e754f617eacaa5cc231288c9caa7a73ef049bfc5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 05:24:08 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 09 Feb 2023 00:24:08 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: JS generated refs: update testsuite conditions Message-ID: <63e4837895107_2b039a52760229352@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a4b9ae77 by Josh Meredith at 2023-02-09T00:23:59-05:00 JS generated refs: update testsuite conditions - - - - - f54f9a43 by sheaf at 2023-02-09T00:24:01-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - 6 changed files: - libraries/transformers - testsuite/tests/driver/T1959/test.T - testsuite/tests/ffi/should_run/all.T - testsuite/tests/rts/all.T - testsuite/tests/safeHaskell/check/pkg01/all.T - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== libraries/transformers ===================================== @@ -1 +1 @@ -Subproject commit ceff1dcd7893f7ab4abb6e66bcd248abd86c8886 +Subproject commit ef4fa181ebea77ac6997d392d1ef5a09524f06b2 ===================================== testsuite/tests/driver/T1959/test.T ===================================== @@ -1 +1 @@ -test('T1959', [extra_files(['B.hs', 'C.hs', 'D.hs', 'E1.hs', 'E2.hs']), js_broken(22261)], makefile_test, ['dotest']) +test('T1959', [extra_files(['B.hs', 'C.hs', 'D.hs', 'E1.hs', 'E2.hs']), js_broken(22374)], makefile_test, ['dotest']) ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -167,10 +167,10 @@ test('T5594', [ omit_ways(['ghci']), ], compile_and_run, ['T5594_c.c -no-hs-main']) -test('Capi_Ctype_001', [extra_files(['Capi_Ctype_A_001.hsc', 'capi_ctype_001.h', 'capi_ctype_001_c.c']), js_broken(22374)], +test('Capi_Ctype_001', [extra_files(['Capi_Ctype_A_001.hsc', 'capi_ctype_001.h', 'capi_ctype_001_c.c']), req_c], makefile_test, ['Capi_Ctype_001']) -test('Capi_Ctype_002', [extra_files(['Capi_Ctype_A_002.hsc', 'capi_ctype_002_A.h', 'capi_ctype_002_B.h']), js_broken(22374)], +test('Capi_Ctype_002', [extra_files(['Capi_Ctype_A_002.hsc', 'capi_ctype_002_A.h', 'capi_ctype_002_B.h']), req_c], makefile_test, ['Capi_Ctype_002']) test('ffi_parsing_001', [omit_ways(['ghci']), req_c], compile_and_run, ===================================== testsuite/tests/rts/all.T ===================================== @@ -258,7 +258,7 @@ test('T6006', [ omit_ways(prof_ways + ['ghci']), # needs it. compile_and_run, ['T6006_c.c -no-hs-main']) -test('T7037', js_broken(22374), makefile_test, ['T7037']) +test('T7037', req_c, makefile_test, ['T7037']) test('T7087', exit_code(1), compile_and_run, ['']) test('T7160', [ omit_ways(['nonmoving_thr', 'nonmoving_thr_ghc']) ===================================== testsuite/tests/safeHaskell/check/pkg01/all.T ===================================== @@ -32,7 +32,7 @@ test('safePkg01', normalise_version("array", "ghc-bignum", "bytestring", "base", "deepseq", "ghc-prim"), normalise_fun(normalise_errmsg), - js_skip], + js_broken(22356)], run_command, ['$MAKE -s --no-print-directory safePkg01 ' + make_args]) # Fail since we enable package trust ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -152,7 +152,7 @@ test('T7702', # allocation done by the plugin... but a regression allocates > 90mb collect_compiler_stats('peak_megabytes_allocated',70), when(opsys('mingw32'), fragile_for(16799, ['normal'])), - js_skip + req_interp ], compile, ['-v0 -package-db T7702plugin/pkg.T7702/local.package.conf -fplugin T7702Plugin -package T7702plugin ' + config.plugin_way_flags]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e754f617eacaa5cc231288c9caa7a73ef049bfc5...f54f9a4363e663b333fc65f115a6c6c221b3b7a1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e754f617eacaa5cc231288c9caa7a73ef049bfc5...f54f9a4363e663b333fc65f115a6c6c221b3b7a1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 05:32:49 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Thu, 09 Feb 2023 00:32:49 -0500 Subject: [Git][ghc/ghc][wip/js-rts-fixmes] JS RTS: use jsClosureCount for closureConstructors and cache sizes Message-ID: <63e4858123d2b_2b039a5260c2341b6@gitlab.mail> Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC Commits: 681aefa9 by Josh Meredith at 2023-02-09T05:32:35+00:00 JS RTS: use jsClosureCount for closureConstructors and cache sizes - - - - - 2 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -133,6 +133,7 @@ module GHC.JS.Make , clsName , dataFieldName, dataFieldNames , varName, varNames + , jsClosureCount ) where @@ -645,7 +646,10 @@ dataFieldCache :: Array Int FastString dataFieldCache = listArray (0,nFieldCache) (map (mkFastString . ('d':) . show) [(0::Int)..nFieldCache]) nFieldCache :: Int -nFieldCache = 16384 +nFieldCache = 256 + +jsClosureCount :: Int +jsClosureCount = 24 dataFieldName :: Int -> FastString dataFieldName i @@ -658,39 +662,39 @@ dataFieldNames = fmap dataFieldName [1..nFieldCache] -- | Cache "h$dXXX" names dataCache :: Array Int FastString -dataCache = listArray (0,63) (map (mkFastString . ("h$d"++) . show) [(0::Int)..63]) +dataCache = listArray (0,nFieldCache) (map (mkFastString . ("h$d"++) . show) [(0::Int)..nFieldCache]) dataName :: Int -> FastString dataName i - | i < 0 || i > 63 = panic "dataCacheName" (ppr i) - | otherwise = dataCache ! i + | i < 0 || i > nFieldCache = panic "dataCacheName" (ppr i) + | otherwise = dataCache ! i allocData :: Int -> JExpr allocData i = toJExpr (TxtI (dataCache ! i)) -- | Cache "h$cXXX" names clsCache :: Array Int FastString -clsCache = listArray (0,63) (map (mkFastString . ("h$c"++) . show) [(0::Int)..63]) +clsCache = listArray (0,jsClosureCount) (map (mkFastString . ("h$c"++) . show) [(0::Int)..jsClosureCount]) clsName :: Int -> FastString clsName i - | i < 0 || i > 63 = panic "clsCacheName" (ppr i) - | otherwise = clsCache ! i + | i < 0 || i > jsClosureCount = panic "clsCacheName" (ppr i) + | otherwise = clsCache ! i allocClsA :: Int -> JExpr allocClsA i = toJExpr (TxtI (clsCache ! i)) -- | Cache "xXXX" names varCache :: Array Int FastString -varCache = listArray (0,63) (map (mkFastString . ('x':) . show) [(0::Int)..63]) +varCache = listArray (0,jsClosureCount) (map (mkFastString . ('x':) . show) [(0::Int)..jsClosureCount]) varName :: Int -> Ident varName i - | i < 0 || i > 63 = panic "varCacheName" (ppr i) - | otherwise = TxtI $ varCache ! i + | i < 0 || i > jsClosureCount = panic "varCacheName" (ppr i) + | otherwise = TxtI $ varCache ! i varNames :: [Ident] -varNames = fmap varName [1..63] +varNames = fmap varName [1..jsClosureCount] -------------------------------------------------------------------------------- ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -81,8 +81,8 @@ resetResultVar r = toJExpr r |= null_ -- JIT can optimize better. closureConstructors :: StgToJSConfig -> JStat closureConstructors s = BlockStat - [ mconcat (map mkClosureCon (Nothing : map Just [0..24])) - , mconcat (map mkDataFill [1..24]) + [ mconcat (map mkClosureCon (Nothing : map Just [0..jsClosureCount])) + , mconcat (map mkDataFill [1..jsClosureCount]) ] where prof = csProf s View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/681aefa924453de4dc3ca926423fc5179ef11789 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/681aefa924453de4dc3ca926423fc5179ef11789 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 07:59:28 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Thu, 09 Feb 2023 02:59:28 -0500 Subject: [Git][ghc/ghc][wip/js-rts-fixmes] 15 commits: Don't allow . in overloaded labels Message-ID: <63e4a7e03577c_2b039a527ec24349e@gitlab.mail> Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC Commits: b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - 42b3ef3d by Josh Meredith at 2023-02-09T07:59:12+00:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} - - - - - 10bcedc4 by Josh Meredith at 2023-02-09T07:59:12+00:00 Cache names used commonly in JS backend RTS generation - - - - - 7cb9e0bb by Sylvain Henry at 2023-02-09T07:59:12+00:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 73bc2a6a by Josh Meredith at 2023-02-09T07:59:12+00:00 JS/Make: reduce cache sizes - - - - - 3b3d40bf by Josh Meredith at 2023-02-09T07:59:12+00:00 JS RTS: use jsClosureCount for closureConstructors and cache sizes - - - - - 30 changed files: - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/JS/Make.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Rename/Bind.hs - compiler/GHC/StgToJS/Printer.hs - compiler/GHC/StgToJS/Rts/Rts.hs - docs/users_guide/9.6.1-notes.rst - libraries/base/GHC/Int.hs - libraries/base/GHC/Word.hs - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/driver/testutil.py - + testsuite/tests/ghc-api/exactprint/T22919.hs - + testsuite/tests/ghc-api/exactprint/T22919.stderr - testsuite/tests/ghc-api/exactprint/Test20239.stderr - testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr - testsuite/tests/ghc-api/exactprint/all.T - testsuite/tests/overloadedrecflds/should_run/T11671_run.hs - testsuite/tests/parser/should_compile/DumpParsedAstComments.hs - testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr - testsuite/tests/printer/Test22771.hs - + testsuite/tests/rename/should_compile/T22913.hs - testsuite/tests/rename/should_compile/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/681aefa924453de4dc3ca926423fc5179ef11789...3b3d40bfd25cd100fa8f0b033aa2426f7b677959 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/681aefa924453de4dc3ca926423fc5179ef11789...3b3d40bfd25cd100fa8f0b033aa2426f7b677959 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 08:24:22 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 09 Feb 2023 03:24:22 -0500 Subject: [Git][ghc/ghc][master] JS generated refs: update testsuite conditions Message-ID: <63e4adb680e8c_2b039a526e824727@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 5 changed files: - testsuite/tests/driver/T1959/test.T - testsuite/tests/ffi/should_run/all.T - testsuite/tests/rts/all.T - testsuite/tests/safeHaskell/check/pkg01/all.T - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== testsuite/tests/driver/T1959/test.T ===================================== @@ -1 +1 @@ -test('T1959', [extra_files(['B.hs', 'C.hs', 'D.hs', 'E1.hs', 'E2.hs']), js_broken(22261)], makefile_test, ['dotest']) +test('T1959', [extra_files(['B.hs', 'C.hs', 'D.hs', 'E1.hs', 'E2.hs']), js_broken(22374)], makefile_test, ['dotest']) ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -167,10 +167,10 @@ test('T5594', [ omit_ways(['ghci']), ], compile_and_run, ['T5594_c.c -no-hs-main']) -test('Capi_Ctype_001', [extra_files(['Capi_Ctype_A_001.hsc', 'capi_ctype_001.h', 'capi_ctype_001_c.c']), js_broken(22374)], +test('Capi_Ctype_001', [extra_files(['Capi_Ctype_A_001.hsc', 'capi_ctype_001.h', 'capi_ctype_001_c.c']), req_c], makefile_test, ['Capi_Ctype_001']) -test('Capi_Ctype_002', [extra_files(['Capi_Ctype_A_002.hsc', 'capi_ctype_002_A.h', 'capi_ctype_002_B.h']), js_broken(22374)], +test('Capi_Ctype_002', [extra_files(['Capi_Ctype_A_002.hsc', 'capi_ctype_002_A.h', 'capi_ctype_002_B.h']), req_c], makefile_test, ['Capi_Ctype_002']) test('ffi_parsing_001', [omit_ways(['ghci']), req_c], compile_and_run, ===================================== testsuite/tests/rts/all.T ===================================== @@ -258,7 +258,7 @@ test('T6006', [ omit_ways(prof_ways + ['ghci']), # needs it. compile_and_run, ['T6006_c.c -no-hs-main']) -test('T7037', js_broken(22374), makefile_test, ['T7037']) +test('T7037', req_c, makefile_test, ['T7037']) test('T7087', exit_code(1), compile_and_run, ['']) test('T7160', [ omit_ways(['nonmoving_thr', 'nonmoving_thr_ghc']) ===================================== testsuite/tests/safeHaskell/check/pkg01/all.T ===================================== @@ -32,7 +32,7 @@ test('safePkg01', normalise_version("array", "ghc-bignum", "bytestring", "base", "deepseq", "ghc-prim"), normalise_fun(normalise_errmsg), - js_skip], + js_broken(22356)], run_command, ['$MAKE -s --no-print-directory safePkg01 ' + make_args]) # Fail since we enable package trust ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -152,7 +152,7 @@ test('T7702', # allocation done by the plugin... but a regression allocates > 90mb collect_compiler_stats('peak_megabytes_allocated',70), when(opsys('mingw32'), fragile_for(16799, ['normal'])), - js_skip + req_interp ], compile, ['-v0 -package-db T7702plugin/pkg.T7702/local.package.conf -fplugin T7702Plugin -package T7702plugin ' + config.plugin_way_flags]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d69ecac2326542534faf8ec5680f54b3a5b8e4da -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d69ecac2326542534faf8ec5680f54b3a5b8e4da You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 08:25:04 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 09 Feb 2023 03:25:04 -0500 Subject: [Git][ghc/ghc][master] Bump transformers to 0.6.1.0 Message-ID: <63e4ade0c52d8_2b039a5267025288a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - 1 changed file: - libraries/transformers Changes: ===================================== libraries/transformers ===================================== @@ -1 +1 @@ -Subproject commit ceff1dcd7893f7ab4abb6e66bcd248abd86c8886 +Subproject commit ef4fa181ebea77ac6997d392d1ef5a09524f06b2 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2ea1a6bc7d7c2946b4a3d1c2c19083e09401f9f1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2ea1a6bc7d7c2946b4a3d1c2c19083e09401f9f1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 09:41:50 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 09 Feb 2023 04:41:50 -0500 Subject: [Git][ghc/ghc][wip/T22924] Furher work Message-ID: <63e4bfde1b09e_2b039a52724266395@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22924 at Glasgow Haskell Compiler / GHC Commits: e93b07a5 by Simon Peyton Jones at 2023-02-09T09:40:27+00:00 Furher work * Restore noGivenNewtypeReprEqs * Revert most of !9623 * Lots of documentation * New test cases T22924a, T22924b for recursive newtypes (One of these is regressed by !9623 which is why we are reverting it) - - - - - 8 changed files: - compiler/GHC/Core/TyCon.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Rewrite.hs - + testsuite/tests/typecheck/should_fail/T22924a.hs - + testsuite/tests/typecheck/should_fail/T22924a.stderr - + testsuite/tests/typecheck/should_fail/T22924b.hs - + testsuite/tests/typecheck/should_fail/T22924b.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -1974,7 +1974,7 @@ isInjectiveTyCon :: TyCon -> Role -> Bool isInjectiveTyCon (TyCon { tyConDetails = details }) role = go details role where - go _ Phantom = True -- Vacuously; (t1 ~P t2) holes for all t1, t2! + go _ Phantom = True -- Vacuously; (t1 ~P t2) holds for all t1, t2! go (AlgTyCon {}) Nominal = True go (AlgTyCon {algTcRhs = rhs}) Representational = isGenInjAlgRhs rhs ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -1084,7 +1084,7 @@ can_eq_nc' _rewritten _rdr_env _envs ev eq_rel -- Decompose type constructor applications -- NB: we have expanded type synonyms already -can_eq_nc' rewritten _rdr_env _envs ev eq_rel ty1 _ ty2 _ +can_eq_nc' _rewritten _rdr_env _envs ev eq_rel ty1 _ ty2 _ | Just (tc1, tys1) <- tcSplitTyConApp_maybe ty1 , Just (tc2, tys2) <- tcSplitTyConApp_maybe ty2 -- we want to catch e.g. Maybe Int ~ (Int -> Int) here for better @@ -1092,7 +1092,7 @@ can_eq_nc' rewritten _rdr_env _envs ev eq_rel ty1 _ ty2 _ -- hence no direct match on TyConApp , not (isTypeFamilyTyCon tc1) , not (isTypeFamilyTyCon tc2) - = canTyConApp rewritten ev eq_rel tc1 tys1 tc2 tys2 + = canTyConApp ev eq_rel tc1 tys1 tc2 tys2 can_eq_nc' _rewritten _rdr_env _envs ev eq_rel s1@(ForAllTy (Bndr _ vis1) _) _ @@ -1114,8 +1114,12 @@ can_eq_nc' True _rdr_env _envs ev NomEq ty1 _ ty2 _ ------------------- -- No similarity in type structure detected. Rewrite and try again. -can_eq_nc' False _rdr_env _envs ev eq_rel _ ps_ty1 _ ps_ty2 - = rewrite_and_try_again ev eq_rel ps_ty1 ps_ty2 +can_eq_nc' False rdr_env envs ev eq_rel _ ps_ty1 _ ps_ty2 + = -- Rewrite the two types and try again + do { (redn1@(Reduction _ xi1), rewriters1) <- rewrite ev ps_ty1 + ; (redn2@(Reduction _ xi2), rewriters2) <- rewrite ev ps_ty2 + ; new_ev <- rewriteEqEvidence (rewriters1 S.<> rewriters2) ev NotSwapped redn1 redn2 + ; can_eq_nc' True rdr_env envs new_ev eq_rel xi1 xi1 xi2 xi2 } ---------------------------- -- Look for a canonical LHS. See Note [Canonical LHS]. @@ -1153,15 +1157,6 @@ can_eq_nc' True _rdr_env _envs ev eq_rel _ ps_ty1 _ ps_ty2 -- No need to call canEqFailure/canEqHardFailure because they -- rewrite, and the types involved here are already rewritten --- Rewrite the two types and try again -rewrite_and_try_again :: CtEvidence -> EqRel -> TcType -> TcType -> TcS (StopOrContinue Ct) -rewrite_and_try_again ev eq_rel ty1 ty2 - = do { (redn1@(Reduction _ xi1), rewriters1) <- rewrite ev ty1 - ; (redn2@(Reduction _ xi2), rewriters2) <- rewrite ev ty2 - ; new_ev <- rewriteEqEvidence (rewriters1 S.<> rewriters2) ev NotSwapped redn1 redn2 - ; rdr_env <- getGlobalRdrEnvTcS - ; envs <- getFamInstEnvs - ; can_eq_nc' True rdr_env envs new_ev eq_rel xi1 xi1 xi2 xi2 } {- Note [Unsolved equalities] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1407,62 +1402,40 @@ which is easier to satisfy. Conclusion: we must unwrap newtypes before decomposing them. This happens in `can_eq_newtype_nc` -But even this is challenging. Here are two cases to consider: +We did flirt with making the /rewriter/ expand newtypes, rather than +doing it in `can_eq_newtype_nc`. But with recursive newtypes we want +to be super-careful about expanding! -Case 1 (extremely contrived): + newtype A = MkA [A] -- Recursive! - newtype Age = MkAge Int - [G] IO s ~ IO t -- where s,t ane not Age,Int - [W] w1 :: IO Age ~R# IO Int + f :: A -> [A] + f = coerce -Case 2: +We have [W] A ~R# [A]. If we rewrite [A], it'll expand to + [[[[[...]]]]] +and blow the reduction stack. See Note [Newtypes can blow the stack] +in GHC.Tc.Solver.Rewrite. But if we expand only the /top level/ of +both sides, we get + [W] [A] ~R# [A] +which we can, just, solve by reflexivity. - newtype A = MkA [A] - [W] A ~R# [A] +So we simply unwrap, on-demand, at top level, in `can_eq_newtype_nc`. -For Case 1, recall that IO is an abstract newtype. Then read Note -[Decomposing newtype equalities]. According to that Note, we should not -decompose w1, because we have an Irred Given that stops decomposition. -Yet we still want to solve the wanted! We can do so by unwrapping the -(non-abstract) Age newtype underneath the IO, giving - [W] w2 :: IO Int ~R# IO Int - w1 = (IO unwrap-Age ; w2) -where unwrap-Age :: Age ~R# Int. Now we case solve w2 by reflexivity; -see Note [Eager reflexivity check]. +This is all very delicate. There is a real risk of a loop in the type checker +with recursive newtypes -- but I think we're doomed to do *something* +delicate, as we're really trying to solve for equirecursive type +equality. Bottom line for users: recursive newtypes are dangerous. See also +Section 5.3.1 and 5.3.4 of "Safe Zero-cost Coercions for Haskell" (JFP 2016). -Conclusion: unwrap newtypes (deeply, inside types) in the rewriter: -specifically in GHC.Tc.Solver.Rewrite.rewrite_newtype_app. +See also Note [Decomposing newtype equalities]. -Yet for Case 2, deep rewriting would be a disaster: we would loop. - [W] A ~R# [A] ---> {unwrap} - [W] [A] ~R# [[A]] - ---> {decompose} - [W] A ~R# [A] +--- Historical side note --- -In this case, we just want to unwrap newtypes /at the top level/, allowing us -to succeed via Note [Eager reflexivity check]: - [W] A ~R# [A] ---> {unwrap at top level only} - [W] [A] ~R# [A] - ---> {reflexivity} success - -Conclusion: to satisfy Case 1 and Case 2, we unwrap -* /both/ at top level, in can_eq_nc' -* /and/ deeply, in the rewriter, rewrite_newtype_app - -The former unwraps outer newtypes (when the data constructor is in scope). -The latter unwraps deeply -- but it won't be invoked in Case 2, when we can -recognize an equality between the types [A] and [A] before rewriting -deeply. - -This "before" business is delicate -- there is still a real risk of a loop -in the type checker with recursive newtypes -- but I think we're doomed to do -*something* delicate, as we're really trying to solve for equirecursive -type equality. Bottom line for users: recursive newtypes are dangerous. -See also Section 5.3.1 and 5.3.4 of -"Safe Zero-cost Coercions for Haskell" (JFP 2016). - -Another approach -- which we ultimately decided against -- is described in -Note [Decomposing newtypes a bit more aggressively]. +We flirted with doing /both/ unwrap-at-top-level /and/ rewrite-deeply; +see #22519. But that didn't work: see discussion in #22924. Specifically +we got a loop with a minor variation: + f2 :: a -> [A] + f2 = coerce Note [Eager reflexivity check] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1492,6 +1465,24 @@ we do a reflexivity check. (This would be sound in the nominal case, but unnecessary, and I [Richard E.] am worried that it would slow down the common case.) + + Note [Newtypes can blow the stack] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have + + newtype X = MkX (Int -> X) + newtype Y = MkY (Int -> Y) + +and now wish to prove + + [W] X ~R Y + +This Wanted will loop, expanding out the newtypes ever deeper looking +for a solid match or a solid discrepancy. Indeed, there is something +appropriate to this looping, because X and Y *do* have the same representation, +in the limit -- they're both (Fix ((->) Int)). However, no finitely-sized +coercion will ever witness it. This loop won't actually cause GHC to hang, +though, because we check our depth in `can_eq_newtype_nc`. -} ------------------------ @@ -1598,8 +1589,7 @@ canEqCast rewritten ev eq_rel swapped ty1 co1 ty2 ps_ty2 role = eqRelRole eq_rel ------------------------ -canTyConApp :: Bool -- True <=> the types have been rewritten - -> CtEvidence -> EqRel +canTyConApp :: CtEvidence -> EqRel -> TyCon -> [TcType] -> TyCon -> [TcType] -> TcS (StopOrContinue Ct) @@ -1607,17 +1597,13 @@ canTyConApp :: Bool -- True <=> the types have been rewritten -- See Note [Decomposing Dependent TyCons and Processing Wanted Equalities] -- Neither tc1 nor tc2 is a saturated funTyCon, nor a type family -- But they can be data families. -canTyConApp rewritten ev eq_rel tc1 tys1 tc2 tys2 +canTyConApp ev eq_rel tc1 tys1 tc2 tys2 | tc1 == tc2 , tys1 `equalLength` tys2 = do { inerts <- getTcSInerts ; if can_decompose inerts then canDecomposableTyConAppOK ev eq_rel tc1 tys1 tys2 - else if rewritten - then canEqFailure ev eq_rel ty1 ty2 - else rewrite_and_try_again ev eq_rel ty1 ty2 } - -- Why rewrite and try again? See Case 1 - -- of Note [Unwrap newtypes first] + else canEqFailure ev eq_rel ty1 ty2 } -- See Note [Skolem abstract data] in GHC.Core.Tycon | tyConSkolem tc1 || tyConSkolem tc2 @@ -1650,8 +1636,7 @@ canTyConApp rewritten ev eq_rel tc1 tys1 tc2 tys2 -- Moreover isInjectiveTyCon is True for Representational -- for algebraic data types. So we are down to newtypes -- and data families. - ctEvFlavour ev == Wanted - -- COMMENTING OUT; see !22924: && noGivenNewtypeReprEqs tc1 inerts) + ctEvFlavour ev == Wanted && noGivenNewtypeReprEqs tc1 inerts) -- See Note [Decomposing newtype equalities] (EX2) {- @@ -1842,11 +1827,11 @@ For a Wanted with r=R, since newtypes are not injective at representational role, decomposition is sound, but we may lose completeness. Nevertheless, if the newtype is abstraction (so can't be unwrapped) we can only solve the equality by (a) using a Given or (b) decomposition. If (a) is impossible -(e.g. no Givens) then (b) is safe. +(e.g. no Givens) then (b) is safe albeit potentially incomplete. -Conclusion: decompose newtypes (at role R) only if there are no usable Givens. +There are two ways in which decomposing (N ty1) ~r (N ty2) could be incomplete: -* Incompleteness example (EX1) +* Incompleteness example (EX1): unwrap first newtype Nt a = MkNt (Id a) type family Id a where Id a = a @@ -1860,34 +1845,45 @@ Conclusion: decompose newtypes (at role R) only if there are no usable Givens. them. This is done in can_eq_nc'. Of course, we can't unwrap if the data constructor isn't in scope. See Note [Unwrap newtypes first]. -* Incompleteness example (EX2) +* Incompleteness example (EX2): available Givens newtype Nt a = Mk Bool -- NB: a is not used in the RHS, type role Nt representational -- but the user gives it an R role anyway - If we have [W] Nt alpha ~R Nt beta, we *don't* want to decompose to - [W] alpha ~R beta, because it's possible that alpha and beta aren't - representationally equal. And maybe there is a Given (Nt t1 ~R Nt t2), - just waiting to be used, if we figure out (elsewhere) that alpha:=t1 - and beta:=t2. This is somewhat similar to the question of overlapping - Givens for class constraints: see Note [Instance and Given overlap] - in GHC.Tc.Solver.Interact. + [G] Nt t1 ~R Nt t2 + [W] Nt alpha ~R Nt beta + + We *don't* want to decompose to [W] alpha ~R beta, because it's possible + that alpha and beta aren't representationally equal. And if we figure + out (elsewhere) that alpha:=t1 and beta:=t2, we can solve the Wanted + from the Given. This is somewhat similar to the question of overlapping + Givens for class constraints: see Note [Instance and Given overlap] in + GHC.Tc.Solver.Interact. Conclusion: don't decompose [W] N s ~R N t, if there are any Given equalities that could later solve it. - But what precisely does "any Given equalities that could later solve it" mean? + But what precisely does it mean to say "any Given equalities that could + later solve it"? - It must be a Given constraint that could turn into N s ~ N t. - That could /in principle/ include [G] (a b) ~ (c d), or even just [G] c. - But since the free vars of a Given are skolems, or at least untouchable - unification variables, it is extremely unlikely that such Givens - will "turn into" [G] N s ~ N t. - - Moreover, in #22908 we had + In #22924 we had [G] f a ~R# a [W] Const (f a) a ~R# Const a a - where Const is a newtype. If we decomposed the newtype, we could solve. - Not-decomposing on the grounds that (f a ~R# a) might turn into - (Const (f a) a ~R# Const a a) seems a bit silly. + where Const is an abstract newtype. If we decomposed the newtype, we + could solve. Not-decomposing on the grounds that (f a ~R# a) might turn + into (Const (f a) a ~R# Const a a) seems a bit silly. + + In #22331 we had + [G] N a ~R# N b [W] N b ~R# N a + (where N is abstract so we can't unwrap). Here we really /don't/ want to + decompose, because the /only/ way to solve the Wanted is from that Given + (with a Sym). + + In #22519 we had + [G] a <= b [W] IO Age ~R# IO Int + (where IO is abstract so we can't unwrap, and newtype Age = Int). Here + we /must/ decompose. (Side note: We flirted with deep-rewriting of + newtypes (see discussion on #22519 and !9623) but that turned out not to + solve #22924, and also makes type inference loop more often on recursive + newtypes.) The currently-implemented compromise is this: @@ -1896,19 +1892,15 @@ Conclusion: decompose newtypes (at role R) only if there are no usable Givens. that is, a Given Irred equality with both sides headed with N. See the call to noGivenNewtypeReprEqs in canTyConApp. - This is still incomplete but only just, and there is no perfect answer. - See #22331 and #22908. + This is not perfect. In principle a Given like [G] (a b) ~ (c d), or + even just [G] c, could later turn into N s ~ N t. But since the free + vars of a Given are skolems, or at least untouchable unification + variables, this is extremely unlikely to happen. - We only look at Irreds. There could, just, be a CDictCan with some + Another worry: there could, just, be a CDictCan with some un-expanded equality superclasses; but only in some very obscure recursive-superclass situations. - Now suppose we have [G] IO t1 ~R# IO t2, [W] IO Age ~R# IO Int, - where t1, t2 are not actually Age, Int. Then noGiveNewtypeReprEqs - will stop us decomposing the Wanted (IO is a newtype). But we - can /still/ win by unwrapping the newtype Age in the rewriter: - see Note [Unwrap newtypes first] - Yet another approach (!) is desribed in Note [Decomposing newtypes a bit more aggressively]. ===================================== compiler/GHC/Tc/Solver/Rewrite.hs ===================================== @@ -42,7 +42,6 @@ import GHC.Builtin.Types (tYPETyCon) import Data.List ( find ) import GHC.Data.List.Infinite (Infinite) import qualified GHC.Data.List.Infinite as Inf -import GHC.Tc.Instance.Family (tcTopNormaliseNewTypeTF_maybe) {- ************************************************************************ @@ -225,10 +224,10 @@ rewrite ev ty ; return result } -- | See Note [Rewriting] --- This variant of 'rewrite' rewrites w.r.t. nominal equality only, --- as this is better than full rewriting for error messages. Specifically, --- we want to avoid unwrapping newtypes, as doing so can end up causing --- an otherwise-unnecessary stack overflow. +-- `rewriteForErrors` is a variant of 'rewrite' that rewrites +-- w.r.t. nominal equality only, as this is better than full rewriting +-- for error messages. (This was important when we flirted with rewriting +-- newtypes but perhaps less so now.) rewriteForErrors :: CtEvidence -> TcType -> TcS (Reduction, RewriterSet) rewriteForErrors ev ty @@ -504,22 +503,9 @@ rewrite_one ty@(TyConApp tc tys) | isTypeFamilyTyCon tc = rewrite_fam_app tc tys - | otherwise - = do { eq_rel <- getEqRel - ; if eq_rel == ReprEq - - then -- Rewriting w.r.t. representational equality requires - -- unwrapping newtypes; see GHC.Tc.Solver.Canonical. - -- Note [Unwrap newtypes first] - -- NB: try rewrite_newtype_app even when tc isn't a newtype; - -- the allows the possibility of having a newtype buried under - -- a synonym. Needed for e.g. T12067. - rewrite_newtype_app ty - - else -- For * a normal data type application - -- * data family application - -- we just recursively rewrite the arguments. - rewrite_ty_con_app tc tys } + | otherwise -- We just recursively rewrite the arguments. + -- See Note [Do not rewrite newtypes] + = rewrite_ty_con_app tc tys rewrite_one (FunTy { ft_af = vis, ft_mult = mult, ft_arg = ty1, ft_res = ty2 }) = do { arg_redn <- rewrite_one ty1 @@ -678,42 +664,12 @@ rewrite_vector ki roles tys fvs = tyCoVarsOfType ki {-# INLINE rewrite_vector #-} --- Rewrite a (potential) newtype application --- Precondition: the ambient EqRel is ReprEq --- Precondition: the type is a TyConApp --- See Note [Newtypes can blow the stack] -rewrite_newtype_app :: TcType -> RewriteM Reduction -rewrite_newtype_app ty@(TyConApp tc tys) - = do { rdr_env <- liftTcS getGlobalRdrEnvTcS - ; tf_envs <- liftTcS getFamInstEnvs - ; case (tcTopNormaliseNewTypeTF_maybe tf_envs rdr_env ty) of - Nothing -> -- Non-newtype or abstract newtype - rewrite_ty_con_app tc tys - - Just ((used_ctors, co), ty') -- co :: ty ~ ty' - -> do { liftTcS $ recordUsedGREs used_ctors - ; checkStackDepth ty - ; rewrite_reduction (Reduction co ty') } } - -rewrite_newtype_app other_ty = pprPanic "rewrite_newtype_app" (ppr other_ty) - -{- Note [Newtypes can blow the stack] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Suppose we have - - newtype X = MkX (Int -> X) - newtype Y = MkY (Int -> Y) - -and now wish to prove - - [W] X ~R Y -This Wanted will loop, expanding out the newtypes ever deeper looking -for a solid match or a solid discrepancy. Indeed, there is something -appropriate to this looping, because X and Y *do* have the same representation, -in the limit -- they're both (Fix ((->) Int)). However, no finitely-sized -coercion will ever witness it. This loop won't actually cause GHC to hang, -though, because we check our depth when unwrapping newtypes. +{- Note [Do not rewrite newtypes] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We flirted with unwrapping newtypes in the rewriter -- see GHC.Tc.Solver.Canonical +Note [Unwrap newtypes first]. But that turned out to be a bad idea because +of recursive newtypes, as that Note says. So be careful if you re-add it! Note [Rewriting synonyms] ~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== testsuite/tests/typecheck/should_fail/T22924a.hs ===================================== @@ -0,0 +1,9 @@ +module T22924a where + +import Data.Coerce + +newtype R = MkR [R] + +f :: a -> [R] +-- Should give a civilised error +f = coerce ===================================== testsuite/tests/typecheck/should_fail/T22924a.stderr ===================================== @@ -0,0 +1,11 @@ + +T22924a.hs:9:5: error: [GHC-10283] + • Couldn't match representation of type ‘a’ with that of ‘[R]’ + arising from a use of ‘coerce’ + ‘a’ is a rigid type variable bound by + the type signature for: + f :: forall a. a -> [R] + at T22924a.hs:7:1-13 + • In the expression: coerce + In an equation for ‘f’: f = coerce + • Relevant bindings include f :: a -> [R] (bound at T22924a.hs:9:1) ===================================== testsuite/tests/typecheck/should_fail/T22924b.hs ===================================== @@ -0,0 +1,10 @@ +module T22924b where + +import Data.Coerce + +newtype R = MkR [R] +newtype S = MkS [S] + +f :: R -> S +-- Blows the typechecker reduction stack +f = coerce ===================================== testsuite/tests/typecheck/should_fail/T22924b.stderr ===================================== @@ -0,0 +1,10 @@ + +T22924b.hs:10:5: error: + • Reduction stack overflow; size = 201 + When simplifying the following type: R + Use -freduction-depth=0 to disable this check + (any upper bound you could choose might fail unpredictably with + minor updates to GHC, so disabling the check is recommended if + you're sure that type checking should terminate) + • In the expression: coerce + In an equation for ‘f’: f = coerce ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -667,3 +667,5 @@ test('T22570', normal, compile_fail, ['']) test('T22645', normal, compile_fail, ['']) test('T20666', normal, compile_fail, ['']) test('T20666a', normal, compile_fail, ['']) +test('T22924a', normal, compile_fail, ['']) +test('T22924b', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e93b07a578adab9e6c8c7bb5cad1be4015733ef3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e93b07a578adab9e6c8c7bb5cad1be4015733ef3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 10:02:59 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 09 Feb 2023 05:02:59 -0500 Subject: [Git][ghc/ghc][wip/T22908] 6 commits: testsuite: remove config.use_threads Message-ID: <63e4c4d339d45_2b039a8fa7a0273026@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22908 at Glasgow Haskell Compiler / GHC Commits: 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - 905f8c3c by Simon Peyton Jones at 2023-02-09T10:03:49+00:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 25 changed files: - compiler/GHC/Parser/Lexer.x - compiler/GHC/Tc/Gen/App.hs - libraries/transformers - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/driver/testutil.py - testsuite/tests/driver/T1959/test.T - testsuite/tests/ffi/should_run/all.T - + testsuite/tests/ghc-api/exactprint/T22919.hs - + testsuite/tests/ghc-api/exactprint/T22919.stderr - testsuite/tests/ghc-api/exactprint/Test20239.stderr - testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr - testsuite/tests/ghc-api/exactprint/all.T - testsuite/tests/ghci/scripts/T12447.stdout - testsuite/tests/ghci/scripts/T14796.stdout - testsuite/tests/ghci/scripts/T17403.stdout - + testsuite/tests/ghci/scripts/T22908.script - + testsuite/tests/ghci/scripts/T22908.stdout - testsuite/tests/ghci/scripts/all.T - testsuite/tests/parser/should_compile/DumpParsedAstComments.hs - testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr - testsuite/tests/rts/all.T - testsuite/tests/safeHaskell/check/pkg01/all.T - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -3700,11 +3700,13 @@ allocatePriorComments ss comment_q mheader_comments = cmp (L l _) = anchor l <= ss (newAnns,after) = partition cmp comment_q comment_q'= after - (prior_comments, decl_comments) = splitPriorComments ss newAnns + (prior_comments, decl_comments) + = case mheader_comments of + Strict.Nothing -> (reverse newAnns, []) + _ -> splitPriorComments ss newAnns in case mheader_comments of Strict.Nothing -> (Strict.Just prior_comments, comment_q', decl_comments) - -- Strict.Nothing -> (Strict.Just [], comment_q', newAnns) Strict.Just _ -> (mheader_comments, comment_q', reverse newAnns) allocateFinalComments ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -543,25 +543,16 @@ tcInstFun do_ql inst_final (rn_fun, fun_ctxt) fun_sigma rn_args HsUnboundVar {} -> True _ -> False - inst_all, inst_inferred, inst_none :: ForAllTyFlag -> Bool - inst_all (Invisible {}) = True - inst_all Required = False - - inst_inferred (Invisible InferredSpec) = True - inst_inferred (Invisible SpecifiedSpec) = False - inst_inferred Required = False - - inst_none _ = False - inst_fun :: [HsExprArg 'TcpRn] -> ForAllTyFlag -> Bool - inst_fun [] | inst_final = inst_all - | otherwise = inst_none - -- Using `inst_none` for `:type` avoids + -- True <=> instantiate a tyvar with this ForAllTyFlag + inst_fun [] | inst_final = isInvisibleForAllTyFlag + | otherwise = const False + -- Using `const False` for `:type` avoids -- `forall {r1} (a :: TYPE r1) {r2} (b :: TYPE r2). a -> b` -- turning into `forall a {r2} (b :: TYPE r2). a -> b`. -- See #21088. - inst_fun (EValArg {} : _) = inst_all - inst_fun _ = inst_inferred + inst_fun (EValArg {} : _) = isInvisibleForAllTyFlag + inst_fun _ = isInferredForAllTyFlag ----------- go, go1 :: Delta @@ -588,7 +579,12 @@ tcInstFun do_ql inst_final (rn_fun, fun_ctxt) fun_sigma rn_args -- c.f. GHC.Tc.Utils.Instantiate.topInstantiate go1 delta acc so_far fun_ty args | (tvs, body1) <- tcSplitSomeForAllTyVars (inst_fun args) fun_ty - , (theta, body2) <- tcSplitPhiTy body1 + , (theta, body2) <- if (inst_fun args Inferred) + then tcSplitPhiTy body1 + else ([], body1) + -- (inst_fun args Inferred): dictionary parameters are like Inferred foralls + -- E.g. #22908: f :: Foo => blah + -- No foralls! But if inst_final=False, don't instantiate , not (null tvs && null theta) = do { (inst_tvs, wrap, fun_rho) <- addHeadCtxt fun_ctxt $ instantiateSigma fun_orig tvs theta body2 ===================================== libraries/transformers ===================================== @@ -1 +1 @@ -Subproject commit ceff1dcd7893f7ab4abb6e66bcd248abd86c8886 +Subproject commit ef4fa181ebea77ac6997d392d1ef5a09524f06b2 ===================================== testsuite/driver/runtests.py ===================================== @@ -26,7 +26,9 @@ from pathlib import Path # So we import it here first, so that the testsuite doesn't appear to fail. import subprocess -from testutil import getStdout, Watcher, str_warn, str_info, print_table, shorten_metric_name +from concurrent.futures import ThreadPoolExecutor + +from testutil import getStdout, str_warn, str_info, print_table, shorten_metric_name from testglobals import getConfig, ghc_env, getTestRun, TestConfig, \ TestOptions, brokens, PerfMetric from my_typing import TestName @@ -151,7 +153,6 @@ config.broken_tests |= {TestName(t) for t in args.broken_test} if args.threads: config.threads = args.threads - config.use_threads = True if args.verbose is not None: config.verbose = args.verbose @@ -481,26 +482,28 @@ if config.list_broken: print('WARNING:', len(t.framework_failures), 'framework failures!') print('') else: - # completion watcher - watcher = Watcher(len(parallelTests)) - # Now run all the tests try: - for oneTest in parallelTests: - if stopping(): - break - oneTest(watcher) + with ThreadPoolExecutor(max_workers=config.threads) as executor: + for oneTest in parallelTests: + if stopping(): + break + oneTest(executor) - # wait for parallel tests to finish - if not stopping(): - watcher.wait() + # wait for parallel tests to finish + if not stopping(): + executor.shutdown(wait=True) # Run the following tests purely sequential - config.use_threads = False - for oneTest in aloneTests: - if stopping(): - break - oneTest(watcher) + with ThreadPoolExecutor(max_workers=1) as executor: + for oneTest in aloneTests: + if stopping(): + break + oneTest(executor) + + if not stopping(): + executor.shutdown(wait=True) + except KeyboardInterrupt: pass ===================================== testsuite/driver/testglobals.py ===================================== @@ -177,7 +177,6 @@ class TestConfig: # threads self.threads = 1 - self.use_threads = False # tests which should be considered to be broken during this testsuite # run. ===================================== testsuite/driver/testlib.py ===================================== @@ -36,10 +36,7 @@ from my_typing import * from threading import Timer from collections import OrderedDict -global pool_sema -if config.use_threads: - import threading - pool_sema = threading.BoundedSemaphore(value=config.threads) +import threading global wantToStop wantToStop = False @@ -84,12 +81,7 @@ def get_all_ways() -> Set[WayName]: # testdir_testopts after each test). global testopts_local -if config.use_threads: - testopts_local = threading.local() -else: - class TestOpts_Local: - pass - testopts_local = TestOpts_Local() # type: ignore +testopts_local = threading.local() def getTestOpts() -> TestOptions: return testopts_local.x @@ -1020,16 +1012,8 @@ parallelTests = [] aloneTests = [] allTestNames = set([]) # type: Set[TestName] -def runTest(watcher, opts, name: TestName, func, args): - if config.use_threads: - pool_sema.acquire() - t = threading.Thread(target=test_common_thread, - name=name, - args=(watcher, name, opts, func, args)) - t.daemon = False - t.start() - else: - test_common_work(watcher, name, opts, func, args) +def runTest(executor, opts, name: TestName, func, args): + return executor.submit(test_common_work, name, opts, func, args) # name :: String # setup :: [TestOpt] -> IO () @@ -1067,20 +1051,13 @@ def test(name: TestName, if name in config.broken_tests: myTestOpts.expect = 'fail' - thisTest = lambda watcher: runTest(watcher, myTestOpts, name, func, args) + thisTest = lambda executor: runTest(executor, myTestOpts, name, func, args) if myTestOpts.alone: aloneTests.append(thisTest) else: parallelTests.append(thisTest) allTestNames.add(name) -if config.use_threads: - def test_common_thread(watcher, name, opts, func, args): - try: - test_common_work(watcher, name, opts, func, args) - finally: - pool_sema.release() - def get_package_cache_timestamp() -> float: if config.package_conf_cache_file is None: return 0.0 @@ -1094,8 +1071,7 @@ do_not_copy = ('.hi', '.o', '.dyn_hi' , '.dyn_o', '.out' ,'.hi-boot', '.o-boot') # 12112 -def test_common_work(watcher: testutil.Watcher, - name: TestName, opts, +def test_common_work(name: TestName, opts, func, args) -> None: try: t.total_tests += 1 @@ -1214,8 +1190,6 @@ def test_common_work(watcher: testutil.Watcher, except Exception as e: framework_fail(name, None, 'Unhandled exception: ' + str(e)) - finally: - watcher.notify() def do_test(name: TestName, way: WayName, ===================================== testsuite/driver/testutil.py ===================================== @@ -5,8 +5,6 @@ import tempfile from pathlib import Path, PurePath from term_color import Color, colored -import threading - from my_typing import * @@ -125,24 +123,6 @@ else: else: os.symlink(str(src), str(dst)) -class Watcher(object): - def __init__(self, count: int) -> None: - self.pool = count - self.evt = threading.Event() - self.sync_lock = threading.Lock() - if count <= 0: - self.evt.set() - - def wait(self): - self.evt.wait() - - def notify(self): - self.sync_lock.acquire() - self.pool -= 1 - if self.pool <= 0: - self.evt.set() - self.sync_lock.release() - def memoize(f): """ A decorator to memoize a nullary function. ===================================== testsuite/tests/driver/T1959/test.T ===================================== @@ -1 +1 @@ -test('T1959', [extra_files(['B.hs', 'C.hs', 'D.hs', 'E1.hs', 'E2.hs']), js_broken(22261)], makefile_test, ['dotest']) +test('T1959', [extra_files(['B.hs', 'C.hs', 'D.hs', 'E1.hs', 'E2.hs']), js_broken(22374)], makefile_test, ['dotest']) ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -167,10 +167,10 @@ test('T5594', [ omit_ways(['ghci']), ], compile_and_run, ['T5594_c.c -no-hs-main']) -test('Capi_Ctype_001', [extra_files(['Capi_Ctype_A_001.hsc', 'capi_ctype_001.h', 'capi_ctype_001_c.c']), js_broken(22374)], +test('Capi_Ctype_001', [extra_files(['Capi_Ctype_A_001.hsc', 'capi_ctype_001.h', 'capi_ctype_001_c.c']), req_c], makefile_test, ['Capi_Ctype_001']) -test('Capi_Ctype_002', [extra_files(['Capi_Ctype_A_002.hsc', 'capi_ctype_002_A.h', 'capi_ctype_002_B.h']), js_broken(22374)], +test('Capi_Ctype_002', [extra_files(['Capi_Ctype_A_002.hsc', 'capi_ctype_002_A.h', 'capi_ctype_002_B.h']), req_c], makefile_test, ['Capi_Ctype_002']) test('ffi_parsing_001', [omit_ways(['ghci']), req_c], compile_and_run, ===================================== testsuite/tests/ghc-api/exactprint/T22919.hs ===================================== @@ -0,0 +1,2 @@ +module T22919 {- comment -} where +foo = 's' ===================================== testsuite/tests/ghc-api/exactprint/T22919.stderr ===================================== @@ -0,0 +1,116 @@ + +==================== Parser AST ==================== + +(L + { T22919.hs:1:1 } + (HsModule + (XModulePs + (EpAnn + (Anchor + { T22919.hs:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnModule (EpaSpan { T22919.hs:1:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { T22919.hs:1:29-33 }))] + (AnnList + (Nothing) + (Nothing) + (Nothing) + [] + []) + (Just + ((,) + { T22919.hs:3:1 } + { T22919.hs:2:7-9 }))) + (EpaCommentsBalanced + [(L + (Anchor + { T22919.hs:1:15-27 } + (UnchangedAnchor)) + (EpaComment + (EpaBlockComment + "{- comment -}") + { T22919.hs:1:8-13 }))] + [])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) + (Just + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:1:8-13 }) + {ModuleName: T22919})) + (Nothing) + [] + [(L + (SrcSpanAnn (EpAnn + (Anchor + { T22919.hs:2:1-9 } + (UnchangedAnchor)) + (AnnListItem + []) + (EpaComments + [])) { T22919.hs:2:1-9 }) + (ValD + (NoExtField) + (FunBind + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-3 }) + (Unqual + {OccName: foo})) + (MG + (FromSource) + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-9 }) + [(L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-9 }) + (Match + (EpAnn + (Anchor + { T22919.hs:2:1-9 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (FunRhs + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-3 }) + (Unqual + {OccName: foo})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (EpaComments + []) + [(L + (SrcSpanAnn + (EpAnnNotUsed) + { T22919.hs:2:5-9 }) + (GRHS + (EpAnn + (Anchor + { T22919.hs:2:5-9 } + (UnchangedAnchor)) + (GrhsAnn + (Nothing) + (AddEpAnn AnnEqual (EpaSpan { T22919.hs:2:5 }))) + (EpaComments + [])) + [] + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:7-9 }) + (HsLit + (EpAnn + (Anchor + { T22919.hs:2:7-9 } + (UnchangedAnchor)) + (NoEpAnns) + (EpaComments + [])) + (HsChar + (SourceText 's') + ('s'))))))] + (EmptyLocalBinds + (NoExtField)))))])))))])) ===================================== testsuite/tests/ghc-api/exactprint/Test20239.stderr ===================================== @@ -23,7 +23,14 @@ { Test20239.hs:8:1 } { Test20239.hs:7:34-63 }))) (EpaCommentsBalanced - [] + [(L + (Anchor + { Test20239.hs:3:1-28 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- | Leading Haddock Comment") + { Test20239.hs:1:18-22 }))] [(L (Anchor { Test20239.hs:7:34-63 } @@ -50,14 +57,7 @@ (AnnListItem []) (EpaComments - [(L - (Anchor - { Test20239.hs:3:1-28 } - (UnchangedAnchor)) - (EpaComment - (EpaLineComment - "-- | Leading Haddock Comment") - { Test20239.hs:1:18-22 }))])) { Test20239.hs:(4,1)-(6,86) }) + [])) { Test20239.hs:(4,1)-(6,86) }) (InstD (NoExtField) (DataFamInstD @@ -323,5 +323,5 @@ -Test20239.hs:4:15: error: [GHC-76037] +Test20239.hs:4:15: [GHC-76037] Not in scope: type constructor or class ‘Method’ ===================================== testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr ===================================== @@ -30,7 +30,15 @@ (EpaComment (EpaLineComment "-- leading comments") - { ZeroWidthSemi.hs:1:22-26 }))] + { ZeroWidthSemi.hs:1:22-26 })) + ,(L + (Anchor + { ZeroWidthSemi.hs:5:1-19 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- Function comment") + { ZeroWidthSemi.hs:3:1-19 }))] [(L (Anchor { ZeroWidthSemi.hs:8:1-58 } @@ -57,14 +65,7 @@ (AnnListItem []) (EpaComments - [(L - (Anchor - { ZeroWidthSemi.hs:5:1-19 } - (UnchangedAnchor)) - (EpaComment - (EpaLineComment - "-- Function comment") - { ZeroWidthSemi.hs:3:1-19 }))])) { ZeroWidthSemi.hs:6:1-5 }) + [])) { ZeroWidthSemi.hs:6:1-5 }) (ValD (NoExtField) (FunBind ===================================== testsuite/tests/ghc-api/exactprint/all.T ===================================== @@ -38,3 +38,4 @@ test('AddHiding1', ignore_stderr, makefile_test, ['AddHiding1']) test('AddHiding2', ignore_stderr, makefile_test, ['AddHiding2']) test('Test20239', normal, compile_fail, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments']) test('ZeroWidthSemi', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments']) +test('T22919', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments']) ===================================== testsuite/tests/ghci/scripts/T12447.stdout ===================================== @@ -1,3 +1,3 @@ deferEither @(_ ~ _) - :: (Typeable w1, Typeable w2) => + :: Deferrable (w1 ~ w2) => proxy (w1 ~ w2) -> ((w1 ~ w2) => r) -> Either String r ===================================== testsuite/tests/ghci/scripts/T14796.stdout ===================================== @@ -1 +1,2 @@ -ECC @() @[] @() :: [()] -> ECC (() :: Constraint) [] () +ECC @() @[] @() + :: (() :: Constraint) => [()] -> ECC (() :: Constraint) [] () ===================================== testsuite/tests/ghci/scripts/T17403.stdout ===================================== @@ -1 +1 @@ -f :: String +f :: (() :: Constraint) => String ===================================== testsuite/tests/ghci/scripts/T22908.script ===================================== @@ -0,0 +1,4 @@ +:set -XMultiParamTypeClasses +class Foo where foo :: Int +:t foo + ===================================== testsuite/tests/ghci/scripts/T22908.stdout ===================================== @@ -0,0 +1 @@ +foo :: Foo => Int ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -372,3 +372,4 @@ test('T21294a', normal, ghci_script, ['T21294a.script']) test('T21507', normal, ghci_script, ['T21507.script']) test('T22695', normal, ghci_script, ['T22695.script']) test('T22817', normal, ghci_script, ['T22817.script']) +test('T22908', normal, ghci_script, ['T22908.script']) ===================================== testsuite/tests/parser/should_compile/DumpParsedAstComments.hs ===================================== @@ -4,6 +4,9 @@ -} module DumpParsedAstComments where +-- comment 1 for bar +-- comment 2 for bar +bar = 1 -- Other comment -- comment 1 for foo ===================================== testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr ===================================== @@ -21,8 +21,8 @@ []) (Just ((,) - { DumpParsedAstComments.hs:17:1 } - { DumpParsedAstComments.hs:16:17-23 }))) + { DumpParsedAstComments.hs:20:1 } + { DumpParsedAstComments.hs:19:17-23 }))) (EpaCommentsBalanced [(L (Anchor @@ -42,12 +42,20 @@ { DumpParsedAstComments.hs:1:1-28 })) ,(L (Anchor - { DumpParsedAstComments.hs:7:1-16 } + { DumpParsedAstComments.hs:7:1-20 } (UnchangedAnchor)) (EpaComment (EpaLineComment - "-- Other comment") - { DumpParsedAstComments.hs:5:30-34 }))] + "-- comment 1 for bar") + { DumpParsedAstComments.hs:5:30-34 })) + ,(L + (Anchor + { DumpParsedAstComments.hs:8:1-20 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- comment 2 for bar") + { DumpParsedAstComments.hs:7:1-20 }))] [])) (VirtualBraces (1)) @@ -62,55 +70,139 @@ [(L (SrcSpanAnn (EpAnn (Anchor - { DumpParsedAstComments.hs:(11,1)-(13,3) } + { DumpParsedAstComments.hs:9:1-7 } + (UnchangedAnchor)) + (AnnListItem + []) + (EpaComments + [])) { DumpParsedAstComments.hs:9:1-7 }) + (ValD + (NoExtField) + (FunBind + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-3 }) + (Unqual + {OccName: bar})) + (MG + (FromSource) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-7 }) + [(L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-7 }) + (Match + (EpAnn + (Anchor + { DumpParsedAstComments.hs:9:1-7 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (FunRhs + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-3 }) + (Unqual + {OccName: bar})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (EpaComments + []) + [(L + (SrcSpanAnn + (EpAnnNotUsed) + { DumpParsedAstComments.hs:9:5-7 }) + (GRHS + (EpAnn + (Anchor + { DumpParsedAstComments.hs:9:5-7 } + (UnchangedAnchor)) + (GrhsAnn + (Nothing) + (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:9:5 }))) + (EpaComments + [])) + [] + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:7 }) + (HsOverLit + (EpAnn + (Anchor + { DumpParsedAstComments.hs:9:7 } + (UnchangedAnchor)) + (NoEpAnns) + (EpaComments + [])) + (OverLit + (NoExtField) + (HsIntegral + (IL + (SourceText 1) + (False) + (1))))))))] + (EmptyLocalBinds + (NoExtField)))))]))))) + ,(L + (SrcSpanAnn (EpAnn + (Anchor + { DumpParsedAstComments.hs:(14,1)-(16,3) } (UnchangedAnchor)) (AnnListItem []) (EpaComments [(L (Anchor - { DumpParsedAstComments.hs:9:1-20 } + { DumpParsedAstComments.hs:10:1-16 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- Other comment") + { DumpParsedAstComments.hs:9:7 })) + ,(L + (Anchor + { DumpParsedAstComments.hs:12:1-20 } (UnchangedAnchor)) (EpaComment (EpaLineComment "-- comment 1 for foo") - { DumpParsedAstComments.hs:7:1-16 })) + { DumpParsedAstComments.hs:10:1-16 })) ,(L (Anchor - { DumpParsedAstComments.hs:10:1-20 } + { DumpParsedAstComments.hs:13:1-20 } (UnchangedAnchor)) (EpaComment (EpaLineComment "-- comment 2 for foo") - { DumpParsedAstComments.hs:9:1-20 - }))])) { DumpParsedAstComments.hs:(11,1)-(13,3) }) + { DumpParsedAstComments.hs:12:1-20 + }))])) { DumpParsedAstComments.hs:(14,1)-(16,3) }) (ValD (NoExtField) (FunBind (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:11:1-3 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:14:1-3 }) (Unqual {OccName: foo})) (MG (FromSource) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,1)-(13,3) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(14,1)-(16,3) }) [(L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,1)-(13,3) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(14,1)-(16,3) }) (Match (EpAnn (Anchor - { DumpParsedAstComments.hs:(11,1)-(13,3) } + { DumpParsedAstComments.hs:(14,1)-(16,3) } (UnchangedAnchor)) [] (EpaComments [])) (FunRhs (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:11:1-3 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:14:1-3 }) (Unqual {OccName: foo})) (Prefix) @@ -122,72 +214,72 @@ [(L (SrcSpanAnn (EpAnnNotUsed) - { DumpParsedAstComments.hs:(11,5)-(13,3) }) + { DumpParsedAstComments.hs:(14,5)-(16,3) }) (GRHS (EpAnn (Anchor - { DumpParsedAstComments.hs:(11,5)-(13,3) } + { DumpParsedAstComments.hs:(14,5)-(16,3) } (UnchangedAnchor)) (GrhsAnn (Nothing) - (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:11:5 }))) + (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:14:5 }))) (EpaComments [])) [] (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,7)-(13,3) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(14,7)-(16,3) }) (HsDo (EpAnn (Anchor - { DumpParsedAstComments.hs:(11,7)-(13,3) } + { DumpParsedAstComments.hs:(14,7)-(16,3) } (UnchangedAnchor)) (AnnList (Just (Anchor - { DumpParsedAstComments.hs:13:3 } + { DumpParsedAstComments.hs:16:3 } (UnchangedAnchor))) (Nothing) (Nothing) - [(AddEpAnn AnnDo (EpaSpan { DumpParsedAstComments.hs:11:7-8 }))] + [(AddEpAnn AnnDo (EpaSpan { DumpParsedAstComments.hs:14:7-8 }))] []) (EpaComments [(L (Anchor - { DumpParsedAstComments.hs:12:3-19 } + { DumpParsedAstComments.hs:15:3-19 } (UnchangedAnchor)) (EpaComment (EpaLineComment "-- normal comment") - { DumpParsedAstComments.hs:11:7-8 }))])) + { DumpParsedAstComments.hs:14:7-8 }))])) (DoExpr (Nothing)) (L (SrcSpanAnn (EpAnn (Anchor - { DumpParsedAstComments.hs:13:3 } + { DumpParsedAstComments.hs:16:3 } (UnchangedAnchor)) (AnnList (Just (Anchor - { DumpParsedAstComments.hs:13:3 } + { DumpParsedAstComments.hs:16:3 } (UnchangedAnchor))) (Nothing) (Nothing) [] []) (EpaComments - [])) { DumpParsedAstComments.hs:13:3 }) + [])) { DumpParsedAstComments.hs:16:3 }) [(L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:13:3 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:3 }) (BodyStmt (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:13:3 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:3 }) (HsOverLit (EpAnn (Anchor - { DumpParsedAstComments.hs:13:3 } + { DumpParsedAstComments.hs:16:3 } (UnchangedAnchor)) (NoEpAnns) (EpaComments @@ -206,45 +298,45 @@ ,(L (SrcSpanAnn (EpAnn (Anchor - { DumpParsedAstComments.hs:16:1-23 } + { DumpParsedAstComments.hs:19:1-23 } (UnchangedAnchor)) (AnnListItem []) (EpaComments [(L (Anchor - { DumpParsedAstComments.hs:15:1-20 } + { DumpParsedAstComments.hs:18:1-20 } (UnchangedAnchor)) (EpaComment (EpaLineComment "-- | Haddock comment") - { DumpParsedAstComments.hs:13:3 - }))])) { DumpParsedAstComments.hs:16:1-23 }) + { DumpParsedAstComments.hs:16:3 + }))])) { DumpParsedAstComments.hs:19:1-23 }) (ValD (NoExtField) (FunBind (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-4 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-4 }) (Unqual {OccName: main})) (MG (FromSource) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-23 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-23 }) [(L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-23 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-23 }) (Match (EpAnn (Anchor - { DumpParsedAstComments.hs:16:1-23 } + { DumpParsedAstComments.hs:19:1-23 } (UnchangedAnchor)) [] (EpaComments [])) (FunRhs (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-4 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-4 }) (Unqual {OccName: main})) (Prefix) @@ -256,42 +348,42 @@ [(L (SrcSpanAnn (EpAnnNotUsed) - { DumpParsedAstComments.hs:16:6-23 }) + { DumpParsedAstComments.hs:19:6-23 }) (GRHS (EpAnn (Anchor - { DumpParsedAstComments.hs:16:6-23 } + { DumpParsedAstComments.hs:19:6-23 } (UnchangedAnchor)) (GrhsAnn (Nothing) - (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:16:6 }))) + (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:19:6 }))) (EpaComments [])) [] (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-23 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:8-23 }) (HsApp (EpAnn (Anchor - { DumpParsedAstComments.hs:16:8-23 } + { DumpParsedAstComments.hs:19:8-23 } (UnchangedAnchor)) (NoEpAnns) (EpaComments [])) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-15 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:8-15 }) (HsVar (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-15 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:8-15 }) (Unqual {OccName: putStrLn})))) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:17-23 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:17-23 }) (HsLit (EpAnn (Anchor - { DumpParsedAstComments.hs:16:17-23 } + { DumpParsedAstComments.hs:19:17-23 } (UnchangedAnchor)) (NoEpAnns) (EpaComments ===================================== testsuite/tests/rts/all.T ===================================== @@ -258,7 +258,7 @@ test('T6006', [ omit_ways(prof_ways + ['ghci']), # needs it. compile_and_run, ['T6006_c.c -no-hs-main']) -test('T7037', js_broken(22374), makefile_test, ['T7037']) +test('T7037', req_c, makefile_test, ['T7037']) test('T7087', exit_code(1), compile_and_run, ['']) test('T7160', [ omit_ways(['nonmoving_thr', 'nonmoving_thr_ghc']) ===================================== testsuite/tests/safeHaskell/check/pkg01/all.T ===================================== @@ -32,7 +32,7 @@ test('safePkg01', normalise_version("array", "ghc-bignum", "bytestring", "base", "deepseq", "ghc-prim"), normalise_fun(normalise_errmsg), - js_skip], + js_broken(22356)], run_command, ['$MAKE -s --no-print-directory safePkg01 ' + make_args]) # Fail since we enable package trust ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -152,7 +152,7 @@ test('T7702', # allocation done by the plugin... but a regression allocates > 90mb collect_compiler_stats('peak_megabytes_allocated',70), when(opsys('mingw32'), fragile_for(16799, ['normal'])), - js_skip + req_interp ], compile, ['-v0 -package-db T7702plugin/pkg.T7702/local.package.conf -fplugin T7702Plugin -package T7702plugin ' + config.plugin_way_flags]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bc868bc0bea28b86f164e670c7db702f36acfa02...905f8c3c3e7cfa907e8a88b2ba3854ae01140fbc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bc868bc0bea28b86f164e670c7db702f36acfa02...905f8c3c3e7cfa907e8a88b2ba3854ae01140fbc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 10:12:45 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 09 Feb 2023 05:12:45 -0500 Subject: [Git][ghc/ghc][wip/T22924] Wibble Message-ID: <63e4c71dbf72d_2b039a526702767bf@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22924 at Glasgow Haskell Compiler / GHC Commits: a47ed9d2 by Simon Peyton Jones at 2023-02-09T10:13:18+00:00 Wibble - - - - - 1 changed file: - compiler/GHC/Tc/Solver/Rewrite.hs Changes: ===================================== compiler/GHC/Tc/Solver/Rewrite.hs ===================================== @@ -498,7 +498,7 @@ rewrite_one (TyVarTy tv) rewrite_one (AppTy ty1 ty2) = rewrite_app_tys ty1 [ty2] -rewrite_one ty@(TyConApp tc tys) +rewrite_one (TyConApp tc tys) -- If it's a type family application, try to reduce it | isTypeFamilyTyCon tc = rewrite_fam_app tc tys View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a47ed9d202e7b26f3fda0dacda245f9e61f5c052 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a47ed9d202e7b26f3fda0dacda245f9e61f5c052 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 10:27:29 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Thu, 09 Feb 2023 05:27:29 -0500 Subject: [Git][ghc/ghc][wip/js-rts-fixmes] JS RTS: use jsClosureCount for closureConstructors and cache sizes Message-ID: <63e4ca91ad0ae_2b039a5267027737e@gitlab.mail> Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC Commits: 0d01f679 by Josh Meredith at 2023-02-09T10:27:15+00:00 JS RTS: use jsClosureCount for closureConstructors and cache sizes - - - - - 2 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -133,6 +133,7 @@ module GHC.JS.Make , clsName , dataFieldName, dataFieldNames , varName, varNames + , jsClosureCount ) where @@ -647,6 +648,9 @@ dataFieldCache = listArray (0,nFieldCache) (map (mkFastString . ('d':) . show) [ nFieldCache :: Int nFieldCache = 16384 +jsClosureCount :: Int +jsClosureCount = 24 + dataFieldName :: Int -> FastString dataFieldName i | i < 0 || i > nFieldCache = panic "dataFieldName" (ppr i) @@ -658,39 +662,39 @@ dataFieldNames = fmap dataFieldName [1..nFieldCache] -- | Cache "h$dXXX" names dataCache :: Array Int FastString -dataCache = listArray (0,63) (map (mkFastString . ("h$d"++) . show) [(0::Int)..63]) +dataCache = listArray (0,nFieldCache) (map (mkFastString . ("h$d"++) . show) [(0::Int)..nFieldCache]) dataName :: Int -> FastString dataName i - | i < 0 || i > 63 = panic "dataCacheName" (ppr i) - | otherwise = dataCache ! i + | i < 0 || i > nFieldCache = panic "dataCacheName" (ppr i) + | otherwise = dataCache ! i allocData :: Int -> JExpr allocData i = toJExpr (TxtI (dataCache ! i)) -- | Cache "h$cXXX" names clsCache :: Array Int FastString -clsCache = listArray (0,63) (map (mkFastString . ("h$c"++) . show) [(0::Int)..63]) +clsCache = listArray (0,jsClosureCount) (map (mkFastString . ("h$c"++) . show) [(0::Int)..jsClosureCount]) clsName :: Int -> FastString clsName i - | i < 0 || i > 63 = panic "clsCacheName" (ppr i) - | otherwise = clsCache ! i + | i < 0 || i > jsClosureCount = panic "clsCacheName" (ppr i) + | otherwise = clsCache ! i allocClsA :: Int -> JExpr allocClsA i = toJExpr (TxtI (clsCache ! i)) -- | Cache "xXXX" names varCache :: Array Int FastString -varCache = listArray (0,63) (map (mkFastString . ('x':) . show) [(0::Int)..63]) +varCache = listArray (0,jsClosureCount) (map (mkFastString . ('x':) . show) [(0::Int)..jsClosureCount]) varName :: Int -> Ident varName i - | i < 0 || i > 63 = panic "varCacheName" (ppr i) - | otherwise = TxtI $ varCache ! i + | i < 0 || i > jsClosureCount = panic "varCacheName" (ppr i) + | otherwise = TxtI $ varCache ! i varNames :: [Ident] -varNames = fmap varName [1..63] +varNames = fmap varName [1..jsClosureCount] -------------------------------------------------------------------------------- ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -81,8 +81,8 @@ resetResultVar r = toJExpr r |= null_ -- JIT can optimize better. closureConstructors :: StgToJSConfig -> JStat closureConstructors s = BlockStat - [ mconcat (map mkClosureCon (Nothing : map Just [0..24])) - , mconcat (map mkDataFill [1..24]) + [ mconcat (map mkClosureCon (Nothing : map Just [0..jsClosureCount])) + , mconcat (map mkDataFill [1..jsClosureCount]) ] where prof = csProf s View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0d01f679cd41466934a02c505a8361526280b5cb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0d01f679cd41466934a02c505a8361526280b5cb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 11:01:04 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Thu, 09 Feb 2023 06:01:04 -0500 Subject: [Git][ghc/ghc][wip/9.2.6-backports] 3 commits: Avoid repeated zonking and tidying of types in `relevant_bindings` Message-ID: <63e4d27011b59_2b039a9b5ac802845c1@gitlab.mail> Zubin pushed to branch wip/9.2.6-backports at Glasgow Haskell Compiler / GHC Commits: fd636a4e by Matthew Pickering at 2023-02-09T16:25:04+05:30 Avoid repeated zonking and tidying of types in `relevant_bindings` The approach taking in this patch is that the tcl_bndrs in TcLclEnv are zonked and tidied eagerly, so that work can be shared across multiple calls to `relevant_bindings`. To test this patch I tried without the `keepThisHole` filter and the test finished quickly. Fixes #14766 - - - - - e222f33c by sheaf at 2023-02-09T16:27:01+05:30 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 (cherry picked from commit 9ee761bf02cdd11c955454a222c85971d95dce11) - - - - - 5383016c by Zubin Duggal at 2023-02-09T16:30:52+05:30 changelog: Add entries for #22913 and #14766 - - - - - 5 changed files: - compiler/GHC/Rename/Bind.hs - compiler/GHC/Tc/Errors.hs - docs/users_guide/9.2.6-notes.rst - + testsuite/tests/rename/should_compile/T22913.hs - testsuite/tests/rename/should_compile/all.T Changes: ===================================== compiler/GHC/Rename/Bind.hs ===================================== @@ -860,17 +860,15 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs -- Rename the pragmas and signatures -- Annoyingly the type variables /are/ in scope for signatures, but - -- /are not/ in scope in the SPECIALISE instance pramas; e.g. - -- instance Eq a => Eq (T a) where - -- (==) :: a -> a -> a - -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-} - ; let (spec_inst_prags, other_sigs) = partition isSpecInstLSig sigs + -- /are not/ in scope in SPECIALISE and SPECIALISE instance pragmas. + -- See Note [Type variable scoping in SPECIALISE pragmas]. + ; let (spec_prags, other_sigs) = partition (isSpecLSig <||> isSpecInstLSig) sigs bound_nms = mkNameSet (collectHsBindsBinders CollNoDictBinders binds') sig_ctxt | is_cls_decl = ClsDeclCtxt cls | otherwise = InstDeclCtxt bound_nms - ; (spec_inst_prags', sip_fvs) <- renameSigs sig_ctxt spec_inst_prags - ; (other_sigs', sig_fvs) <- bindLocalNamesFV ktv_names $ - renameSigs sig_ctxt other_sigs + ; (spec_prags', spg_fvs) <- renameSigs sig_ctxt spec_prags + ; (other_sigs', sig_fvs) <- bindLocalNamesFV ktv_names $ + renameSigs sig_ctxt other_sigs -- Rename the bindings RHSs. Again there's an issue about whether the -- type variables from the class/instance head are in scope. @@ -881,8 +879,47 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs emptyFVs binds_w_dus ; return (mapBag fstOf3 binds_w_dus, bind_fvs) } - ; return ( binds'', spec_inst_prags' ++ other_sigs' - , sig_fvs `plusFV` sip_fvs `plusFV` bind_fvs) } + ; return ( binds'', spec_prags' ++ other_sigs' + , sig_fvs `plusFV` spg_fvs `plusFV` bind_fvs) } + +{- Note [Type variable scoping in SPECIALISE pragmas] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When renaming the methods of a class or instance declaration, we must be careful +with the scoping of the type variables that occur in SPECIALISE and SPECIALISE instance +pragmas: the type variables from the class/instance header DO NOT scope over these, +unlike class/instance method type signatures. + +Examples: + + 1. SPECIALISE + + class C a where + meth :: a + instance C (Maybe a) where + meth = Nothing + {-# SPECIALISE INLINE meth :: Maybe [a] #-} + + 2. SPECIALISE instance + + instance Eq a => Eq (T a) where + (==) :: a -> a -> a + {-# SPECIALISE instance Eq a => Eq (T [a]) #-} + + In both cases, the type variable `a` mentioned in the PRAGMA is NOT the same + as the type variable `a` from the instance header. + For example, the SPECIALISE instance pragma above is a shorthand for + + {-# SPECIALISE instance forall a. Eq a => Eq (T [a]) #-} + + which is alpha-equivalent to + + {-# SPECIALISE instance forall b. Eq b => Eq (T [b]) #-} + + This shows that the type variables are not bound in the header. + + Getting this scoping wrong can lead to out-of-scope type variable errors from + Core Lint, see e.g. #22913. +-} rnMethodBindLHS :: Bool -> Name -> LHsBindLR GhcPs GhcPs ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -48,6 +48,7 @@ import GHC.Types.Id import GHC.Types.Var import GHC.Types.Var.Set import GHC.Types.Var.Env +import GHC.Types.Name.Env import GHC.Types.Name.Set import GHC.Data.Bag import GHC.Utils.Error ( pprLocMsgEnvelope ) @@ -67,7 +68,7 @@ import GHC.Data.Maybe import qualified GHC.LanguageExtensions as LangExt import GHC.Utils.FV ( fvVarList, unionFV ) -import Control.Monad ( when, unless ) +import Control.Monad ( when, foldM, forM_ ) import Data.Foldable ( toList ) import Data.List ( partition, mapAccumL, sortBy, unfoldr ) @@ -740,23 +741,58 @@ mkSkolReporter ctxt cts reportHoles :: [Ct] -- other (tidied) constraints -> ReportErrCtxt -> [Hole] -> TcM () -reportHoles tidy_cts ctxt - = mapM_ $ \hole -> unless (ignoreThisHole ctxt hole) $ - do { err <- mkHoleError tidy_cts ctxt hole - ; maybeReportHoleError ctxt hole err - ; maybeAddDeferredHoleBinding ctxt err hole } - -ignoreThisHole :: ReportErrCtxt -> Hole -> Bool +reportHoles tidy_cts ctxt holes + = do + let holes' = filter (keepThisHole ctxt) holes + -- Zonk and tidy all the TcLclEnvs before calling `mkHoleError` + -- because otherwise types will be zonked and tidied many times over. + (tidy_env', lcl_name_cache) <- zonkTidyTcLclEnvs (cec_tidy ctxt) (map (ctl_env . hole_loc) holes') + let ctxt' = ctxt { cec_tidy = tidy_env' } + forM_ holes' $ \hole -> + do { err <- mkHoleError lcl_name_cache tidy_cts ctxt' hole + ; maybeReportHoleError ctxt hole err + ; maybeAddDeferredHoleBinding ctxt err hole } + +keepThisHole :: ReportErrCtxt -> Hole -> Bool -- See Note [Skip type holes rapidly] -ignoreThisHole ctxt hole +keepThisHole ctxt hole = case hole_sort hole of - ExprHole {} -> False - TypeHole -> ignore_type_hole - ConstraintHole -> ignore_type_hole + ExprHole {} -> True + TypeHole -> keep_type_hole + ConstraintHole -> keep_type_hole + where + keep_type_hole = case cec_type_holes ctxt of + HoleDefer -> False + _ -> True + +-- | zonkTidyTcLclEnvs takes a bunch of 'TcLclEnv's, each from a Hole. +-- It returns a ('Name' :-> 'Type') mapping which gives the zonked, tidied +-- type for each Id in any of the binder stacks in the 'TcLclEnv's. +-- Since there is a huge overlap between these stacks, is is much, +-- much faster to do them all at once, avoiding duplication. +zonkTidyTcLclEnvs :: TidyEnv -> [TcLclEnv] -> TcM (TidyEnv, NameEnv Type) +zonkTidyTcLclEnvs tidy_env lcls = foldM go (tidy_env, emptyNameEnv) (concatMap tcl_bndrs lcls) where - ignore_type_hole = case cec_type_holes ctxt of - HoleDefer -> True - _ -> False + go envs tc_bndr = case tc_bndr of + TcTvBndr {} -> return envs + TcIdBndr id _top_lvl -> go_one (idName id) (idType id) envs + TcIdBndr_ExpType name et _top_lvl -> + do { mb_ty <- readExpType_maybe et + -- et really should be filled in by now. But there's a chance + -- it hasn't, if, say, we're reporting a kind error en route to + -- checking a term. See test indexed-types/should_fail/T8129 + -- Or we are reporting errors from the ambiguity check on + -- a local type signature + ; case mb_ty of + Just ty -> go_one name ty envs + Nothing -> return envs + } + go_one name ty (tidy_env, name_env) = do + if name `elemNameEnv` name_env + then return (tidy_env, name_env) + else do + (tidy_env', tidy_ty) <- zonkTidyTcType tidy_env ty + return (tidy_env', extendNameEnv name_env name tidy_ty) {- Note [Skip type holes rapidly] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1193,8 +1229,8 @@ mkIrredErr ctxt cts (ct1:_) = cts ---------------- -mkHoleError :: [Ct] -> ReportErrCtxt -> Hole -> TcM (MsgEnvelope DecoratedSDoc) -mkHoleError _tidy_simples _ctxt hole@(Hole { hole_occ = occ +mkHoleError :: NameEnv Type -> [Ct] -> ReportErrCtxt -> Hole -> TcM (MsgEnvelope DecoratedSDoc) +mkHoleError _ _tidy_simples _ctxt hole@(Hole { hole_occ = occ , hole_ty = hole_ty , hole_loc = ct_loc }) | isOutOfScopeHole hole @@ -1219,12 +1255,12 @@ mkHoleError _tidy_simples _ctxt hole@(Hole { hole_occ = occ boring_type = isTyVarTy hole_ty -- general case: not an out-of-scope error -mkHoleError tidy_simples ctxt hole@(Hole { hole_occ = occ +mkHoleError lcl_name_cache tidy_simples ctxt hole@(Hole { hole_occ = occ , hole_ty = hole_ty , hole_sort = sort , hole_loc = ct_loc }) - = do { (ctxt, binds_msg) - <- relevant_bindings False ctxt lcl_env (tyCoVarsOfType hole_ty) + = do { binds_msg + <- relevant_bindings False lcl_env lcl_name_cache (tyCoVarsOfType hole_ty) -- The 'False' means "don't filter the bindings"; see Trac #8191 ; show_hole_constraints <- goptM Opt_ShowHoleConstraints @@ -2945,21 +2981,23 @@ relevantBindings want_filtering ctxt ct -- Put a zonked, tidied CtOrigin into the Ct loc' = setCtLocOrigin loc tidy_orig ct' = setCtLoc ct loc' - ctxt1 = ctxt { cec_tidy = env1 } - ; (ctxt2, doc) <- relevant_bindings want_filtering ctxt1 lcl_env ct_fvs - ; return (ctxt2, doc, ct') } + ; (env2, lcl_name_cache) <- zonkTidyTcLclEnvs env1 [lcl_env] + + ; doc <- relevant_bindings want_filtering lcl_env lcl_name_cache ct_fvs + ; let ctxt' = ctxt { cec_tidy = env2 } + ; return (ctxt', doc, ct') } where loc = ctLoc ct lcl_env = ctLocEnv loc -- slightly more general version, to work also with holes relevant_bindings :: Bool - -> ReportErrCtxt -> TcLclEnv + -> NameEnv Type -- Cache of already zonked and tidied types -> TyCoVarSet - -> TcM (ReportErrCtxt, SDoc) -relevant_bindings want_filtering ctxt lcl_env ct_tvs + -> TcM SDoc +relevant_bindings want_filtering lcl_env lcl_name_env ct_tvs = do { dflags <- getDynFlags ; traceTc "relevant_bindings" $ vcat [ ppr ct_tvs @@ -2968,8 +3006,8 @@ relevant_bindings want_filtering ctxt lcl_env ct_tvs , pprWithCommas id [ ppr id | TcIdBndr_ExpType id _ _ <- tcl_bndrs lcl_env ] ] - ; (tidy_env', docs, discards) - <- go dflags (cec_tidy ctxt) (maxRelevantBinds dflags) + ; (docs, discards) + <- go dflags (maxRelevantBinds dflags) emptyVarSet [] False (removeBindingShadowing $ tcl_bndrs lcl_env) -- tcl_bndrs has the innermost bindings first, @@ -2979,9 +3017,7 @@ relevant_bindings want_filtering ctxt lcl_env ct_tvs hang (text "Relevant bindings include") 2 (vcat docs $$ ppWhen discards discardMsg) - ctxt' = ctxt { cec_tidy = tidy_env' } - - ; return (ctxt', doc) } + ; return doc } where run_out :: Maybe Int -> Bool run_out Nothing = False @@ -2991,17 +3027,17 @@ relevant_bindings want_filtering ctxt lcl_env ct_tvs dec_max = fmap (\n -> n - 1) - go :: DynFlags -> TidyEnv -> Maybe Int -> TcTyVarSet -> [SDoc] + go :: DynFlags -> Maybe Int -> TcTyVarSet -> [SDoc] -> Bool -- True <=> some filtered out due to lack of fuel -> [TcBinder] - -> TcM (TidyEnv, [SDoc], Bool) -- The bool says if we filtered any out + -> TcM ([SDoc], Bool) -- The bool says if we filtered any out -- because of lack of fuel - go _ tidy_env _ _ docs discards [] - = return (tidy_env, reverse docs, discards) - go dflags tidy_env n_left tvs_seen docs discards (tc_bndr : tc_bndrs) + go _ _ _ docs discards [] + = return (reverse docs, discards) + go dflags n_left tvs_seen docs discards (tc_bndr : tc_bndrs) = case tc_bndr of TcTvBndr {} -> discard_it - TcIdBndr id top_lvl -> go2 (idName id) (idType id) top_lvl + TcIdBndr id top_lvl -> go2 (idName id) top_lvl TcIdBndr_ExpType name et top_lvl -> do { mb_ty <- readExpType_maybe et -- et really should be filled in by now. But there's a chance @@ -3010,14 +3046,16 @@ relevant_bindings want_filtering ctxt lcl_env ct_tvs -- Or we are reporting errors from the ambiguity check on -- a local type signature ; case mb_ty of - Just ty -> go2 name ty top_lvl + Just _ty -> go2 name top_lvl Nothing -> discard_it -- No info; discard } where - discard_it = go dflags tidy_env n_left tvs_seen docs + discard_it = go dflags n_left tvs_seen docs discards tc_bndrs - go2 id_name id_type top_lvl - = do { (tidy_env', tidy_ty) <- zonkTidyTcType tidy_env id_type + go2 id_name top_lvl + = do { let tidy_ty = case lookupNameEnv lcl_name_env id_name of + Just tty -> tty + Nothing -> pprPanic "relevant_bindings" (ppr id_name) ; traceTc "relevantBindings 1" (ppr id_name <+> dcolon <+> ppr tidy_ty) ; let id_tvs = tyCoVarsOfType tidy_ty doc = sep [ pprPrefixOcc id_name <+> dcolon <+> ppr tidy_ty @@ -3039,12 +3077,12 @@ relevant_bindings want_filtering ctxt lcl_env ct_tvs else if run_out n_left && id_tvs `subVarSet` tvs_seen -- We've run out of n_left fuel and this binding only -- mentions already-seen type variables, so discard it - then go dflags tidy_env n_left tvs_seen docs + then go dflags n_left tvs_seen docs True -- Record that we have now discarded something tc_bndrs -- Keep this binding, decrement fuel - else go dflags tidy_env' (dec_max n_left) new_seen + else go dflags (dec_max n_left) new_seen (doc:docs) discards tc_bndrs } ===================================== docs/users_guide/9.2.6-notes.rst ===================================== @@ -58,6 +58,12 @@ Compiler - Fix a driver bug where certain non-fatal Safe Haskell related warnings were being marked as fatal (:ghc-ticket:`22728`). +- Fix a core lint error arises from incorrect scoping of type variables in + specialise pragmas inside class instances (:ghc-ticket:`22913`). + +- Improve typchecker performance for modules with holes in type signatures + (:ghc-ticket:`14766`). + Runtime system -------------- ===================================== testsuite/tests/rename/should_compile/T22913.hs ===================================== @@ -0,0 +1,10 @@ +module T22913 where + +class FromSourceIO a where + fromSourceIO :: a +instance FromSourceIO (Maybe o) where + fromSourceIO = undefined + {-# SPECIALISE INLINE fromSourceIO :: Maybe o #-} + -- This SPECIALISE pragma caused a Core Lint error + -- due to incorrectly scoping the type variable 'o' from the instance header + -- over the SPECIALISE pragma. ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -178,3 +178,4 @@ test('T18497', [], makefile_test, ['T18497']) test('T18264', [], makefile_test, ['T18264']) test('T18302', expect_broken(18302), compile, ['']) test('T17853', [], multimod_compile, ['T17853', '-v0']) +test('T22913', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/06a4a65fff9268589270e99762d5d18a64cabc6c...5383016c78fe4b2555e0aae9248bea5b42f67a78 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/06a4a65fff9268589270e99762d5d18a64cabc6c...5383016c78fe4b2555e0aae9248bea5b42f67a78 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 12:42:06 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Thu, 09 Feb 2023 07:42:06 -0500 Subject: [Git][ghc/ghc][wip/unboxed-codebuffer] 41 commits: Improve treatment of type applications in patterns Message-ID: <63e4ea1e92bd2_2b039a9b5ac803138b7@gitlab.mail> Josh Meredith pushed to branch wip/unboxed-codebuffer at Glasgow Haskell Compiler / GHC Commits: 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - 14a8af20 by Josh Meredith at 2023-02-09T12:40:21+00:00 CodeBuffer: change to use unboxed tuples for encoders/decoders Updates submodules for filepath and haskeline - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/CmmToLlvm/Mangler.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/List/SetOps.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Env.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7b29cd8ab59ba90ca32afcd776647162a7d9470a...14a8af2057477fff528b58eade83ed527fda2197 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7b29cd8ab59ba90ca32afcd776647162a7d9470a...14a8af2057477fff528b58eade83ed527fda2197 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 12:51:41 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 09 Feb 2023 07:51:41 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/mp-backports-batch-2 Message-ID: <63e4ec5d4faae_2b039a9b5ac80323767@gitlab.mail> Matthew Pickering pushed new branch wip/mp-backports-batch-2 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/mp-backports-batch-2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 14:16:09 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Thu, 09 Feb 2023 09:16:09 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/modiface-nfdata-format Message-ID: <63e5002913ef2_2b039a527103355c9@gitlab.mail> Zubin pushed new branch wip/modiface-nfdata-format at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/modiface-nfdata-format You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 14:16:34 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Thu, 09 Feb 2023 09:16:34 -0500 Subject: [Git][ghc/ghc][wip/modiface-nfdata-format] compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` Message-ID: <63e500428c0f3_2b039a526fc33572c@gitlab.mail> Zubin pushed to branch wip/modiface-nfdata-format at Glasgow Haskell Compiler / GHC Commits: 9092a663 by Zubin Duggal at 2023-02-09T19:43:53+05:30 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1 changed file: - compiler/GHC/Unit/Module/ModIface.hs Changes: ===================================== compiler/GHC/Unit/Module/ModIface.hs ===================================== @@ -550,11 +550,11 @@ emptyIfaceHashCache _occ = Nothing -- Take care, this instance only forces to the degree necessary to -- avoid major space leaks. instance (NFData (IfaceBackendExts (phase :: ModIfacePhase)), NFData (IfaceDeclExts (phase :: ModIfacePhase))) => NFData (ModIface_ phase) where - rnf (ModIface f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 - f13 f14 f15 f16 f17 f18 f19 f20 f21 f22 f23 f24) = - rnf f1 `seq` rnf f2 `seq` f3 `seq` f4 `seq` f5 `seq` f6 `seq` rnf f7 `seq` f8 `seq` - f9 `seq` rnf f10 `seq` rnf f11 `seq` rnf f12 `seq` f13 `seq` rnf f14 `seq` rnf f15 `seq` rnf f16 `seq` - rnf f17 `seq` f18 `seq` rnf f19 `seq` rnf f20 `seq` rnf f21 `seq` f22 `seq` f23 `seq` rnf f24 + rnf (ModIface mi_module mi_sig_of mi_hsc_src mi_deps mi_usages mi_exports mi_used_th mi_fixities mi_warns mi_anns mi_decls mi_extra_decls + mi_globals mi_insts mi_fam_insts mi_rules mi_hpc mi_trust mi_trust_pkg mi_complete_matches mi_docs mi_final_exts mi_ext_fields mi_src_hash) = + rnf mi_module `seq` rnf mi_sig_of `seq` mi_hsc_src `seq` mi_deps `seq` mi_usages `seq` mi_exports `seq` rnf mi_used_th `seq` mi_fixities `seq` + mi_warns `seq` rnf mi_anns `seq` rnf mi_decls `seq` rnf mi_extra_decls `seq` mi_globals `seq` rnf mi_insts `seq` rnf mi_fam_insts `seq` rnf mi_rules `seq` + rnf mi_hpc `seq` mi_trust `seq` rnf mi_trust_pkg `seq` rnf mi_complete_matches `seq` rnf mi_docs `seq` mi_final_exts `seq` mi_ext_fields `seq` rnf mi_src_hash `seq` () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9092a66348e7322b2446f2294e430e19ee4e2cf1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9092a66348e7322b2446f2294e430e19ee4e2cf1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 14:17:53 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Thu, 09 Feb 2023 09:17:53 -0500 Subject: [Git][ghc/ghc][wip/modiface-nfdata-format] compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` Message-ID: <63e5009190fe9_2b039a527103379fe@gitlab.mail> Zubin pushed to branch wip/modiface-nfdata-format at Glasgow Haskell Compiler / GHC Commits: 4fc35400 by Zubin Duggal at 2023-02-09T19:47:41+05:30 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1 changed file: - compiler/GHC/Unit/Module/ModIface.hs Changes: ===================================== compiler/GHC/Unit/Module/ModIface.hs ===================================== @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE NamedFieldPuns #-} module GHC.Unit.Module.ModIface ( ModIface @@ -549,20 +550,58 @@ emptyIfaceHashCache _occ = Nothing -- Take care, this instance only forces to the degree necessary to -- avoid major space leaks. -instance (NFData (IfaceBackendExts (phase :: ModIfacePhase)), NFData (IfaceDeclExts (phase :: ModIfacePhase))) => NFData (ModIface_ phase) where - rnf (ModIface f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 - f13 f14 f15 f16 f17 f18 f19 f20 f21 f22 f23 f24) = - rnf f1 `seq` rnf f2 `seq` f3 `seq` f4 `seq` f5 `seq` f6 `seq` rnf f7 `seq` f8 `seq` - f9 `seq` rnf f10 `seq` rnf f11 `seq` rnf f12 `seq` f13 `seq` rnf f14 `seq` rnf f15 `seq` rnf f16 `seq` - rnf f17 `seq` f18 `seq` rnf f19 `seq` rnf f20 `seq` rnf f21 `seq` f22 `seq` f23 `seq` rnf f24 +instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase)) + , NFData (IfaceDeclExts (phase :: ModIfacePhase)) + ) => NFData (ModIface_ phase) where + rnf (ModIface{ mi_module, mi_sig_of, mi_hsc_src, mi_deps, mi_usages + , mi_exports, mi_used_th, mi_fixities, mi_warns, mi_anns + , mi_decls, mi_extra_decls, mi_globals, mi_insts + , mi_fam_insts, mi_rules, mi_hpc, mi_trust, mi_trust_pkg + , mi_complete_matches, mi_docs, mi_final_exts + , mi_ext_fields, mi_src_hash}) + = rnf mi_module + `seq` rnf mi_sig_of + `seq` mi_hsc_src + `seq` mi_deps + `seq` mi_usages + `seq` mi_exports + `seq` rnf mi_used_th + `seq` mi_fixities + `seq` mi_warns + `seq` rnf mi_anns + `seq` rnf mi_decls + `seq` rnf mi_extra_decls + `seq` mi_globals + `seq` rnf mi_insts + `seq` rnf mi_fam_insts + `seq` rnf mi_rules + `seq` rnf mi_hpc + `seq` mi_trust + `seq` rnf mi_trust_pkg + `seq` rnf mi_complete_matches + `seq` rnf mi_docs + `seq` mi_final_exts + `seq` mi_ext_fields + `seq` rnf mi_src_hash `seq` () - instance NFData (ModIfaceBackend) where - rnf (ModIfaceBackend f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13) - = rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` - rnf f5 `seq` rnf f6 `seq` rnf f7 `seq` rnf f8 `seq` - rnf f9 `seq` rnf f10 `seq` rnf f11 `seq` rnf f12 `seq` rnf f13 + rnf (ModIfaceBackend{ mi_iface_hash, mi_mod_hash, mi_flag_hash, mi_opt_hash + , mi_hpc_hash, mi_plugin_hash, mi_orphan, mi_finsts, mi_exp_hash + , mi_orphan_hash, mi_warn_fn, mi_fix_fn, mi_hash_fn}) + = rnf mi_iface_hash + `seq` rnf mi_mod_hash + `seq` rnf mi_flag_hash + `seq` rnf mi_opt_hash + `seq` rnf mi_hpc_hash + `seq` rnf mi_plugin_hash + `seq` rnf mi_orphan + `seq` rnf mi_finsts + `seq` rnf mi_exp_hash + `seq` rnf mi_orphan_hash + `seq` rnf mi_warn_fn + `seq` rnf mi_fix_fn + `seq` rnf mi_hash_fn forceModIface :: ModIface -> IO () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4fc354006c55ac5ef609ab6a5ef2201836eac96a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4fc354006c55ac5ef609ab6a5ef2201836eac96a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 14:31:36 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Thu, 09 Feb 2023 09:31:36 -0500 Subject: [Git][ghc/ghc][wip/or-pats] Fix test errors Message-ID: <63e503c8d1938_2b039a52724338485@gitlab.mail> David pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: c5248a75 by David Knothe at 2023-02-09T15:31:31+01:00 Fix test errors - - - - - 2 changed files: - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs Changes: ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -1000,7 +1000,7 @@ reservedWordsFM = listToUFM $ ( "mdo", ITmdo Nothing, xbit RecursiveDoBit), -- See Note [Lexing type pseudo-keywords] ( "family", ITfamily, 0 ), - ( "one", ITone, 0 ), + ( "one", ITone, xbit OrPatternsBit), ( "role", ITrole, 0 ), ( "pattern", ITpattern, xbit PatternSynonymsBit), ( "static", ITstatic, xbit StaticPointersBit ), ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -1177,6 +1177,9 @@ checkFPat loc (L l e@(PatBuilderVar (L ln c))) tyargs args | (not (null args) && patIsRec c) = do ctx <- askParseContext patFail (locA l) . PsErrInPat e $ PEIP_RecPattern args YesPatIsRecursive ctx + | not (null args) = do + details <- fromParseContext <$> askParseContext + patFail (locA l) (PsErrInPat e details) | otherwise = return $ L l (VarPat noExtField (L ln c)) checkFPat loc (L _ (PatBuilderAppType f at t)) tyargs args = checkFPat loc f (HsConPatTyArg at t : tyargs) args View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c5248a7556f9bde5a639ffee5fa5242c0fa21f60 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c5248a7556f9bde5a639ffee5fa5242c0fa21f60 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 14:51:03 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 09 Feb 2023 09:51:03 -0500 Subject: [Git][ghc/ghc][wip/T22115] 91 commits: Detect family instance orphans correctly Message-ID: <63e508575b713_2b039a526e834665b@gitlab.mail> Ben Gamari pushed to branch wip/T22115 at Glasgow Haskell Compiler / GHC Commits: 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 6e52fcb9 by Ben Gamari at 2023-02-09T09:50:55-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - cabal.project-reinstall - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Reg.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/BlockLayout.hs - compiler/GHC/CmmToAsm/Dwarf.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b7dafe662095781bdcc45a45c418e347a76348cd...6e52fcb915baa1acb38ad2b1f313e8e6a89899f5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b7dafe662095781bdcc45a45c418e347a76348cd...6e52fcb915baa1acb38ad2b1f313e8e6a89899f5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 14:57:43 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 09 Feb 2023 09:57:43 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: JS generated refs: update testsuite conditions Message-ID: <63e509e721c7e_2b039a526e8350087@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - 6890c148 by konsumlamm at 2023-02-09T09:57:36-05:00 Update `Data.List.singleton` doc comment - - - - - 3ba9142d by Ben Gamari at 2023-02-09T09:57:36-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - 8 changed files: - .gitlab/merge_request_templates/merge-request.md - libraries/base/Data/OldList.hs - libraries/transformers - testsuite/tests/driver/T1959/test.T - testsuite/tests/ffi/should_run/all.T - testsuite/tests/rts/all.T - testsuite/tests/safeHaskell/check/pkg01/all.T - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== .gitlab/merge_request_templates/merge-request.md ===================================== @@ -5,18 +5,19 @@ expectations. Also please answer the following question in your MR description:* **Where is the key part of this patch? That is, what should reviewers look at first?** -Please take a few moments to verify that your commits fulfill the following: +Please take a few moments to address the following points: - * [ ] are either individually buildable or squashed - * [ ] have commit messages which describe *what they do* - (referring to [Notes][notes] and tickets using `#NNNN` syntax when - appropriate) + * [ ] if your MR may break existing programs (e.g. touches `base` or causes the + compiler to reject programs), please describe the expected breakage and add + the ~"user facing" label. This will run ghc/head.hackage> to characterise + the effect of your change on Hackage. + * [ ] ensure that your commits are either individually buildable or squashed + * [ ] ensure that your commit messages describe *what they do* + (referring to tickets using `#NNNN` syntax when appropriate) * [ ] have added source comments describing your change. For larger changes you likely should add a [Note][notes] and cross-reference it from the relevant places. - * [ ] add a [testcase to the testsuite](https://gitlab.haskell.org/ghc/ghc/wikis/building/running-tests/adding). - * [ ] if your MR affects library interfaces (e.g. changes `base`) or affects whether GHC will accept user-written code, please add - the ~"user facing" label. + * [ ] add a [testcase to the testsuite][adding test]. * [ ] updates the users guide if applicable * [ ] mentions new features in the release notes for the next release @@ -29,3 +30,4 @@ no one has offerred review in a few days then please leave a comment mentioning @triagers. [notes]: https://gitlab.haskell.org/ghc/ghc/wikis/commentary/coding-style#comments-in-the-source-code +[adding test]: https://gitlab.haskell.org/ghc/ghc/wikis/building/running-tests/adding ===================================== libraries/base/Data/OldList.hs ===================================== @@ -1511,7 +1511,7 @@ sortOn :: Ord b => (a -> b) -> [a] -> [a] sortOn f = map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x)) --- | Produce singleton list. +-- | Construct a list from a single element. -- -- >>> singleton True -- [True] ===================================== libraries/transformers ===================================== @@ -1 +1 @@ -Subproject commit ceff1dcd7893f7ab4abb6e66bcd248abd86c8886 +Subproject commit ef4fa181ebea77ac6997d392d1ef5a09524f06b2 ===================================== testsuite/tests/driver/T1959/test.T ===================================== @@ -1 +1 @@ -test('T1959', [extra_files(['B.hs', 'C.hs', 'D.hs', 'E1.hs', 'E2.hs']), js_broken(22261)], makefile_test, ['dotest']) +test('T1959', [extra_files(['B.hs', 'C.hs', 'D.hs', 'E1.hs', 'E2.hs']), js_broken(22374)], makefile_test, ['dotest']) ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -167,10 +167,10 @@ test('T5594', [ omit_ways(['ghci']), ], compile_and_run, ['T5594_c.c -no-hs-main']) -test('Capi_Ctype_001', [extra_files(['Capi_Ctype_A_001.hsc', 'capi_ctype_001.h', 'capi_ctype_001_c.c']), js_broken(22374)], +test('Capi_Ctype_001', [extra_files(['Capi_Ctype_A_001.hsc', 'capi_ctype_001.h', 'capi_ctype_001_c.c']), req_c], makefile_test, ['Capi_Ctype_001']) -test('Capi_Ctype_002', [extra_files(['Capi_Ctype_A_002.hsc', 'capi_ctype_002_A.h', 'capi_ctype_002_B.h']), js_broken(22374)], +test('Capi_Ctype_002', [extra_files(['Capi_Ctype_A_002.hsc', 'capi_ctype_002_A.h', 'capi_ctype_002_B.h']), req_c], makefile_test, ['Capi_Ctype_002']) test('ffi_parsing_001', [omit_ways(['ghci']), req_c], compile_and_run, ===================================== testsuite/tests/rts/all.T ===================================== @@ -258,7 +258,7 @@ test('T6006', [ omit_ways(prof_ways + ['ghci']), # needs it. compile_and_run, ['T6006_c.c -no-hs-main']) -test('T7037', js_broken(22374), makefile_test, ['T7037']) +test('T7037', req_c, makefile_test, ['T7037']) test('T7087', exit_code(1), compile_and_run, ['']) test('T7160', [ omit_ways(['nonmoving_thr', 'nonmoving_thr_ghc']) ===================================== testsuite/tests/safeHaskell/check/pkg01/all.T ===================================== @@ -32,7 +32,7 @@ test('safePkg01', normalise_version("array", "ghc-bignum", "bytestring", "base", "deepseq", "ghc-prim"), normalise_fun(normalise_errmsg), - js_skip], + js_broken(22356)], run_command, ['$MAKE -s --no-print-directory safePkg01 ' + make_args]) # Fail since we enable package trust ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -152,7 +152,7 @@ test('T7702', # allocation done by the plugin... but a regression allocates > 90mb collect_compiler_stats('peak_megabytes_allocated',70), when(opsys('mingw32'), fragile_for(16799, ['normal'])), - js_skip + req_interp ], compile, ['-v0 -package-db T7702plugin/pkg.T7702/local.package.conf -fplugin T7702Plugin -package T7702plugin ' + config.plugin_way_flags]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f54f9a4363e663b333fc65f115a6c6c221b3b7a1...3ba9142df0e0f07bafb113f5361614fd3b9babc6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f54f9a4363e663b333fc65f115a6c6c221b3b7a1...3ba9142df0e0f07bafb113f5361614fd3b9babc6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 15:15:20 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Thu, 09 Feb 2023 10:15:20 -0500 Subject: [Git][ghc/ghc][wip/or-pats] 79 commits: ghc-the-library: Retain cafs in both static in dynamic builds. Message-ID: <63e50e08b82d_2b039a526fc357227@gitlab.mail> David pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - 39234321 by David Knothe at 2023-02-09T16:12:01+01:00 Add Or Patterns (proposal 0522) - - - - - 92b811d6 by David Knothe at 2023-02-09T16:12:02+01:00 Update submodule haddock & linting stuff - - - - - da87ad2e by David Knothe at 2023-02-09T16:12:03+01:00 Write user guide entry - - - - - 78f5d9a1 by David Knothe at 2023-02-09T16:12:04+01:00 Add EPAs - - - - - f931da29 by David Knothe at 2023-02-09T16:12:05+01:00 Update submodule haddock - - - - - 08fa293a by David Knothe at 2023-02-09T16:12:05+01:00 Add EPA test - - - - - 9cb69faa by Sebastian Graf at 2023-02-09T16:12:06+01:00 Adjust the pattern-match checker for Or patterns Previously, any pattern match or guard could be desugared into a vector of elementary `PmGrd`s (called `GrdVec`) that must all match conjunctively. But with Or patterns, that is bound to change, quite drastically so: Or patterns imply disjunctive matching, and because they may occur nestedly inside other patterns, we need to widen our `GrdVec` type to accomodate both conjunctive/sequential as well as disjunctive/alternative composition. This leads to a rather modest generalisation of the guard tree formalism, yielding guard *directed acyclic graphs*. These DAGs are *series-parallel*, that is to say a *very* benign kind of DAG that is nearly a tree, and which can be defined easily as an inductive data type, `GrdDag`. Beyond adjustments to use the new graph constructors, the rest is just routine re-use of the existing `topToBottom` combinator in `GHC.HsToCore.Pmc.Check`. Nice! - - - - - da22ed42 by David Knothe at 2023-02-09T16:12:07+01:00 Minor things - - - - - 44471088 by David Knothe at 2023-02-09T16:12:07+01:00 Fix test errors - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - cabal.project-reinstall - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Reg.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c5248a7556f9bde5a639ffee5fa5242c0fa21f60...444710889360821b9fbe83e16354ef7543c84740 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c5248a7556f9bde5a639ffee5fa5242c0fa21f60...444710889360821b9fbe83e16354ef7543c84740 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 15:26:20 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 09 Feb 2023 10:26:20 -0500 Subject: [Git][ghc/ghc][wip/T22924] 6 commits: testsuite: remove config.use_threads Message-ID: <63e5109c84a99_2b039a527603582d5@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22924 at Glasgow Haskell Compiler / GHC Commits: 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - 3bb8cc4d by Simon Peyton Jones at 2023-02-09T15:22:44+00:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 29 changed files: - compiler/GHC/Core/TyCon.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Rewrite.hs - libraries/transformers - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/driver/testutil.py - testsuite/tests/driver/T1959/test.T - testsuite/tests/ffi/should_run/all.T - + testsuite/tests/ghc-api/exactprint/T22919.hs - + testsuite/tests/ghc-api/exactprint/T22919.stderr - testsuite/tests/ghc-api/exactprint/Test20239.stderr - testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr - testsuite/tests/ghc-api/exactprint/all.T - testsuite/tests/parser/should_compile/DumpParsedAstComments.hs - testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr - testsuite/tests/rts/all.T - testsuite/tests/safeHaskell/check/pkg01/all.T - testsuite/tests/simplCore/should_compile/all.T - + testsuite/tests/typecheck/should_compile/T22924.hs - testsuite/tests/typecheck/should_compile/all.T - + testsuite/tests/typecheck/should_fail/T22924a.hs - + testsuite/tests/typecheck/should_fail/T22924a.stderr - + testsuite/tests/typecheck/should_fail/T22924b.hs - + testsuite/tests/typecheck/should_fail/T22924b.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -1974,7 +1974,7 @@ isInjectiveTyCon :: TyCon -> Role -> Bool isInjectiveTyCon (TyCon { tyConDetails = details }) role = go details role where - go _ Phantom = True -- Vacuously; (t1 ~P t2) holes for all t1, t2! + go _ Phantom = True -- Vacuously; (t1 ~P t2) holds for all t1, t2! go (AlgTyCon {}) Nominal = True go (AlgTyCon {algTcRhs = rhs}) Representational = isGenInjAlgRhs rhs ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -3700,11 +3700,13 @@ allocatePriorComments ss comment_q mheader_comments = cmp (L l _) = anchor l <= ss (newAnns,after) = partition cmp comment_q comment_q'= after - (prior_comments, decl_comments) = splitPriorComments ss newAnns + (prior_comments, decl_comments) + = case mheader_comments of + Strict.Nothing -> (reverse newAnns, []) + _ -> splitPriorComments ss newAnns in case mheader_comments of Strict.Nothing -> (Strict.Just prior_comments, comment_q', decl_comments) - -- Strict.Nothing -> (Strict.Just [], comment_q', newAnns) Strict.Just _ -> (mheader_comments, comment_q', reverse newAnns) allocateFinalComments ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -1084,7 +1084,7 @@ can_eq_nc' _rewritten _rdr_env _envs ev eq_rel -- Decompose type constructor applications -- NB: we have expanded type synonyms already -can_eq_nc' rewritten _rdr_env _envs ev eq_rel ty1 _ ty2 _ +can_eq_nc' _rewritten _rdr_env _envs ev eq_rel ty1 _ ty2 _ | Just (tc1, tys1) <- tcSplitTyConApp_maybe ty1 , Just (tc2, tys2) <- tcSplitTyConApp_maybe ty2 -- we want to catch e.g. Maybe Int ~ (Int -> Int) here for better @@ -1092,7 +1092,7 @@ can_eq_nc' rewritten _rdr_env _envs ev eq_rel ty1 _ ty2 _ -- hence no direct match on TyConApp , not (isTypeFamilyTyCon tc1) , not (isTypeFamilyTyCon tc2) - = canTyConApp rewritten ev eq_rel tc1 tys1 tc2 tys2 + = canTyConApp ev eq_rel tc1 tys1 tc2 tys2 can_eq_nc' _rewritten _rdr_env _envs ev eq_rel s1@(ForAllTy (Bndr _ vis1) _) _ @@ -1114,8 +1114,12 @@ can_eq_nc' True _rdr_env _envs ev NomEq ty1 _ ty2 _ ------------------- -- No similarity in type structure detected. Rewrite and try again. -can_eq_nc' False _rdr_env _envs ev eq_rel _ ps_ty1 _ ps_ty2 - = rewrite_and_try_again ev eq_rel ps_ty1 ps_ty2 +can_eq_nc' False rdr_env envs ev eq_rel _ ps_ty1 _ ps_ty2 + = -- Rewrite the two types and try again + do { (redn1@(Reduction _ xi1), rewriters1) <- rewrite ev ps_ty1 + ; (redn2@(Reduction _ xi2), rewriters2) <- rewrite ev ps_ty2 + ; new_ev <- rewriteEqEvidence (rewriters1 S.<> rewriters2) ev NotSwapped redn1 redn2 + ; can_eq_nc' True rdr_env envs new_ev eq_rel xi1 xi1 xi2 xi2 } ---------------------------- -- Look for a canonical LHS. See Note [Canonical LHS]. @@ -1153,15 +1157,6 @@ can_eq_nc' True _rdr_env _envs ev eq_rel _ ps_ty1 _ ps_ty2 -- No need to call canEqFailure/canEqHardFailure because they -- rewrite, and the types involved here are already rewritten --- Rewrite the two types and try again -rewrite_and_try_again :: CtEvidence -> EqRel -> TcType -> TcType -> TcS (StopOrContinue Ct) -rewrite_and_try_again ev eq_rel ty1 ty2 - = do { (redn1@(Reduction _ xi1), rewriters1) <- rewrite ev ty1 - ; (redn2@(Reduction _ xi2), rewriters2) <- rewrite ev ty2 - ; new_ev <- rewriteEqEvidence (rewriters1 S.<> rewriters2) ev NotSwapped redn1 redn2 - ; rdr_env <- getGlobalRdrEnvTcS - ; envs <- getFamInstEnvs - ; can_eq_nc' True rdr_env envs new_ev eq_rel xi1 xi1 xi2 xi2 } {- Note [Unsolved equalities] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1407,62 +1402,41 @@ which is easier to satisfy. Conclusion: we must unwrap newtypes before decomposing them. This happens in `can_eq_newtype_nc` -But even this is challenging. Here are two cases to consider: - -Case 1: - - newtype Age = MkAge Int - [G] c - [W] w1 :: IO Age ~R# IO Int - -Case 2: - - newtype A = MkA [A] - [W] A ~R# [A] - -For Case 1, recall that IO is an abstract newtype. Then read Note -[Decomposing newtype equalities]. According to that Note, we should not -decompose w1, because we have an Irred Given. Yet we still want to solve -the wanted! We can do so by unwrapping the (non-abstract) Age newtype -underneath the IO, giving - [W] w2 :: IO Int ~R# IO Int - w1 = (IO unwrap-Age ; w2) -where unwrap-Age :: Age ~R# Int. Now we case solve w2 by reflexivity; -see Note [Eager reflexivity check]. - -Conclusion: unwrap newtypes (deeply, inside types) in the rewriter: -specifically in GHC.Tc.Solver.Rewrite.rewrite_newtype_app. - -Yet for Case 2, deep rewriting would be a disaster: we would loop. - [W] A ~R# [A] ---> {unwrap} - [W] [A] ~R# [[A]] - ---> {decompose} - [W] A ~R# [A] - -In this case, we just want to unwrap newtypes /at the top level/, allowing us -to succeed via Note [Eager reflexivity check]: - [W] A ~R# [A] ---> {unwrap at top level only} - [W] [A] ~R# [A] - ---> {reflexivity} success - -Conclusion: to satisfy Case 1 and Case 2, we unwrap -* /both/ at top level, in can_eq_nc' -* /and/ deeply, in the rewriter, rewrite_newtype_app - -The former unwraps outer newtypes (when the data constructor is in scope). -The latter unwraps deeply -- but it won't be invoked in Case 2, when we can -recognize an equality between the types [A] and [A] before rewriting -deeply. - -This "before" business is delicate -- there is still a real risk of a loop -in the type checker with recursive newtypes -- but I think we're doomed to do -*something* delicate, as we're really trying to solve for equirecursive -type equality. Bottom line for users: recursive newtypes are dangerous. -See also Section 5.3.1 and 5.3.4 of +We did flirt with making the /rewriter/ expand newtypes, rather than +doing it in `can_eq_newtype_nc`. But with recursive newtypes we want +to be super-careful about expanding! + + newtype A = MkA [A] -- Recursive! + + f :: A -> [A] + f = coerce + +We have [W] A ~R# [A]. If we rewrite [A], it'll expand to + [[[[[...]]]]] +and blow the reduction stack. See Note [Newtypes can blow the stack] +in GHC.Tc.Solver.Rewrite. But if we expand only the /top level/ of +both sides, we get + [W] [A] ~R# [A] +which we can, just, solve by reflexivity. + +So we simply unwrap, on-demand, at top level, in `can_eq_newtype_nc`. + +This is all very delicate. There is a real risk of a loop in the type checker +with recursive newtypes -- but I think we're doomed to do *something* +delicate, as we're really trying to solve for equirecursive type +equality. Bottom line for users: recursive newtypes do not play well with type +inference for representational equality. See also Section 5.3.1 and 5.3.4 of "Safe Zero-cost Coercions for Haskell" (JFP 2016). -Another approach -- which we ultimately decided against -- is described in -Note [Decomposing newtypes a bit more aggressively]. +See also Note [Decomposing newtype equalities]. + +--- Historical side note --- + +We flirted with doing /both/ unwrap-at-top-level /and/ rewrite-deeply; +see #22519. But that didn't work: see discussion in #22924. Specifically +we got a loop with a minor variation: + f2 :: a -> [A] + f2 = coerce Note [Eager reflexivity check] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1492,6 +1466,24 @@ we do a reflexivity check. (This would be sound in the nominal case, but unnecessary, and I [Richard E.] am worried that it would slow down the common case.) + + Note [Newtypes can blow the stack] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have + + newtype X = MkX (Int -> X) + newtype Y = MkY (Int -> Y) + +and now wish to prove + + [W] X ~R Y + +This Wanted will loop, expanding out the newtypes ever deeper looking +for a solid match or a solid discrepancy. Indeed, there is something +appropriate to this looping, because X and Y *do* have the same representation, +in the limit -- they're both (Fix ((->) Int)). However, no finitely-sized +coercion will ever witness it. This loop won't actually cause GHC to hang, +though, because we check our depth in `can_eq_newtype_nc`. -} ------------------------ @@ -1598,8 +1590,7 @@ canEqCast rewritten ev eq_rel swapped ty1 co1 ty2 ps_ty2 role = eqRelRole eq_rel ------------------------ -canTyConApp :: Bool -- True <=> the types have been rewritten - -> CtEvidence -> EqRel +canTyConApp :: CtEvidence -> EqRel -> TyCon -> [TcType] -> TyCon -> [TcType] -> TcS (StopOrContinue Ct) @@ -1607,17 +1598,13 @@ canTyConApp :: Bool -- True <=> the types have been rewritten -- See Note [Decomposing Dependent TyCons and Processing Wanted Equalities] -- Neither tc1 nor tc2 is a saturated funTyCon, nor a type family -- But they can be data families. -canTyConApp rewritten ev eq_rel tc1 tys1 tc2 tys2 +canTyConApp ev eq_rel tc1 tys1 tc2 tys2 | tc1 == tc2 , tys1 `equalLength` tys2 = do { inerts <- getTcSInerts ; if can_decompose inerts then canDecomposableTyConAppOK ev eq_rel tc1 tys1 tys2 - else if rewritten - then canEqFailure ev eq_rel ty1 ty2 - else rewrite_and_try_again ev eq_rel ty1 ty2 } - -- Why rewrite and try again? See Case 1 - -- of Note [Unwrap newtypes first] + else canEqFailure ev eq_rel ty1 ty2 } -- See Note [Skolem abstract data] in GHC.Core.Tycon | tyConSkolem tc1 || tyConSkolem tc2 @@ -1641,7 +1628,7 @@ canTyConApp rewritten ev eq_rel tc1 tys1 tc2 tys2 ty2 = mkTyConApp tc2 tys2 -- See Note [Decomposing TyConApp equalities] - -- Note [Decomposing newtypes a bit more aggressively] + -- and Note [Decomposing newtype equalities] can_decompose inerts = isInjectiveTyCon tc1 (eqRelRole eq_rel) || (assert (eq_rel == ReprEq) $ @@ -1650,7 +1637,8 @@ canTyConApp rewritten ev eq_rel tc1 tys1 tc2 tys2 -- Moreover isInjectiveTyCon is True for Representational -- for algebraic data types. So we are down to newtypes -- and data families. - ctEvFlavour ev == Wanted && noGivenIrreds inerts) + ctEvFlavour ev == Wanted && noGivenNewtypeReprEqs tc1 inerts) + -- See Note [Decomposing newtype equalities] (EX2) {- Note [Use canEqFailure in canDecomposableTyConApp] @@ -1838,13 +1826,13 @@ Example is wrinkle {1} in Note [Decomposing TyConApp equalities]. For a Wanted with r=R, since newtypes are not injective at representational role, decomposition is sound, but we may lose completeness. Nevertheless, -if the newtype is abstraction (so can't be unwrapped) we can only solve +if the newtype is abstract (so can't be unwrapped) we can only solve the equality by (a) using a Given or (b) decomposition. If (a) is impossible -(e.g. no Givens) then (b) is safe. +(e.g. no Givens) then (b) is safe albeit potentially incomplete. -Conclusion: decompose newtypes (at role R) only if there are no usable Givens. +There are two ways in which decomposing (N ty1) ~r (N ty2) could be incomplete: -* Incompleteness example (EX1) +* Incompleteness example (EX1): unwrap first newtype Nt a = MkNt (Id a) type family Id a where Id a = a @@ -1856,39 +1844,68 @@ Conclusion: decompose newtypes (at role R) only if there are no usable Givens. Conclusion: always unwrap newtypes before attempting to decompose them. This is done in can_eq_nc'. Of course, we can't unwrap if the data - constructor isn't in scope. See See Note [Unwrap newtypes first]. + constructor isn't in scope. See Note [Unwrap newtypes first]. -* Incompleteness example (EX2) +* Incompleteness example (EX2): available Givens newtype Nt a = Mk Bool -- NB: a is not used in the RHS, type role Nt representational -- but the user gives it an R role anyway - If we have [W] Nt alpha ~R Nt beta, we *don't* want to decompose to - [W] alpha ~R beta, because it's possible that alpha and beta aren't - representationally equal. + [G] Nt t1 ~R Nt t2 + [W] Nt alpha ~R Nt beta - and maybe there is a Given (Nt t1 ~R Nt t2), just waiting to be used, if we - figure out (elsewhere) that alpha:=t1 and beta:=t2. This is somewhat - similar to the question of overlapping Givens for class constraints: see - Note [Instance and Given overlap] in GHC.Tc.Solver.Interact. + We *don't* want to decompose to [W] alpha ~R beta, because it's possible + that alpha and beta aren't representationally equal. And if we figure + out (elsewhere) that alpha:=t1 and beta:=t2, we can solve the Wanted + from the Given. This is somewhat similar to the question of overlapping + Givens for class constraints: see Note [Instance and Given overlap] in + GHC.Tc.Solver.Interact. Conclusion: don't decompose [W] N s ~R N t, if there are any Given equalities that could later solve it. - But what does "any Given equalities that could later solve it" mean, precisely? - It must be a Given constraint that could turn into N s ~ N t. But that - could include [G] (a b) ~ (c d), or even just [G] c. But it'll definitely - be an CIrredCan. So we settle for having no CIrredCans at all, which is - conservative but safe. See noGivenIrreds and #22331. + But what precisely does it mean to say "any Given equalities that could + later solve it"? + + In #22924 we had + [G] f a ~R# a [W] Const (f a) a ~R# Const a a + where Const is an abstract newtype. If we decomposed the newtype, we + could solve. Not-decomposing on the grounds that (f a ~R# a) might turn + into (Const (f a) a ~R# Const a a) seems a bit silly. + + In #22331 we had + [G] N a ~R# N b [W] N b ~R# N a + (where N is abstract so we can't unwrap). Here we really /don't/ want to + decompose, because the /only/ way to solve the Wanted is from that Given + (with a Sym). + + In #22519 we had + [G] a <= b [W] IO Age ~R# IO Int + + (where IO is abstract so we can't unwrap, and newtype Age = Int; and (<=) + is a type-level comparison on Nats). Here we /must/ decompose, despite the + existence of an Irred Given, or we will simply be stuck. (Side note: We + flirted with deep-rewriting of newtypes (see discussion on #22519 and + !9623) but that turned out not to solve #22924, and also makes type + inference loop more often on recursive newtypes.) + + The currently-implemented compromise is this: + + we decompose [W] N s ~R# N t unless there is a [G] N s' ~ N t' + + that is, a Given Irred equality with both sides headed with N. + See the call to noGivenNewtypeReprEqs in canTyConApp. + + This is not perfect. In principle a Given like [G] (a b) ~ (c d), or + even just [G] c, could later turn into N s ~ N t. But since the free + vars of a Given are skolems, or at least untouchable unification + variables, this is extremely unlikely to happen. - Well not 100.0% safe. There could be a CDictCan with some un-expanded - superclasses; but only in some very obscure recursive-superclass - situations. + Another worry: there could, just, be a CDictCan with some + un-expanded equality superclasses; but only in some very obscure + recursive-superclass situations. -If there are no Irred Givens (which is quite common) then we will -successfuly decompose [W] (IO Age) ~R (IO Int), and solve it. But -that won't happen and [W] (IO Age) ~R (IO Int) will be stuck. -We /could/, however, be a bit more aggressive about decomposition; -see Note [Decomposing newtypes a bit more aggressively]. + Yet another approach (!) is desribed in + Note [Decomposing newtypes a bit more aggressively]. Remember: decomposing Wanteds is always /sound/. This Note is only about /completeness/. @@ -1896,7 +1913,8 @@ only about /completeness/. Note [Decomposing newtypes a bit more aggressively] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ IMPORTANT: the ideas in this Note are *not* implemented. Instead, the -current approach is detailed in Note [Unwrap newtypes first]. +current approach is detailed in Note [Decomposing newtype equalities] +and Note [Unwrap newtypes first]. For more details about the ideas in this Note see * GHC propoosal: https://github.com/ghc-proposals/ghc-proposals/pull/549 * issue #22441 ===================================== compiler/GHC/Tc/Solver/InertSet.hs ===================================== @@ -21,7 +21,7 @@ module GHC.Tc.Solver.InertSet ( addInertItem, noMatchableGivenDicts, - noGivenIrreds, + noGivenNewtypeReprEqs, mightEqualLater, prohibitedSuperClassSolve, @@ -1537,9 +1537,22 @@ isOuterTyVar tclvl tv -- becomes "outer" even though its level numbers says it isn't. | otherwise = False -- Coercion variables; doesn't much matter -noGivenIrreds :: InertSet -> Bool -noGivenIrreds (IS { inert_cans = inert_cans }) - = isEmptyBag (inert_irreds inert_cans) +noGivenNewtypeReprEqs :: TyCon -> InertSet -> Bool +-- True <=> there is no Irred looking like (N tys1 ~ N tys2) +-- See Note [Decomposing newtype equalities] (EX2) in GHC.Tc.Solver.Canonical +-- This is the only call site. +noGivenNewtypeReprEqs tc inerts + = not (anyBag might_help (inert_irreds (inert_cans inerts))) + where + might_help ct + = case classifyPredType (ctPred ct) of + EqPred ReprEq t1 t2 + | Just (tc1,_) <- tcSplitTyConApp_maybe t1 + , tc == tc1 + , Just (tc2,_) <- tcSplitTyConApp_maybe t2 + , tc == tc2 + -> True + _ -> False -- | Returns True iff there are no Given constraints that might, -- potentially, match the given class consraint. This is used when checking to see if a ===================================== compiler/GHC/Tc/Solver/Rewrite.hs ===================================== @@ -42,7 +42,6 @@ import GHC.Builtin.Types (tYPETyCon) import Data.List ( find ) import GHC.Data.List.Infinite (Infinite) import qualified GHC.Data.List.Infinite as Inf -import GHC.Tc.Instance.Family (tcTopNormaliseNewTypeTF_maybe) {- ************************************************************************ @@ -225,10 +224,10 @@ rewrite ev ty ; return result } -- | See Note [Rewriting] --- This variant of 'rewrite' rewrites w.r.t. nominal equality only, --- as this is better than full rewriting for error messages. Specifically, --- we want to avoid unwrapping newtypes, as doing so can end up causing --- an otherwise-unnecessary stack overflow. +-- `rewriteForErrors` is a variant of 'rewrite' that rewrites +-- w.r.t. nominal equality only, as this is better than full rewriting +-- for error messages. (This was important when we flirted with rewriting +-- newtypes but perhaps less so now.) rewriteForErrors :: CtEvidence -> TcType -> TcS (Reduction, RewriterSet) rewriteForErrors ev ty @@ -499,27 +498,14 @@ rewrite_one (TyVarTy tv) rewrite_one (AppTy ty1 ty2) = rewrite_app_tys ty1 [ty2] -rewrite_one ty@(TyConApp tc tys) +rewrite_one (TyConApp tc tys) -- If it's a type family application, try to reduce it | isTypeFamilyTyCon tc = rewrite_fam_app tc tys - | otherwise - = do { eq_rel <- getEqRel - ; if eq_rel == ReprEq - - then -- Rewriting w.r.t. representational equality requires - -- unwrapping newtypes; see GHC.Tc.Solver.Canonical. - -- Note [Unwrap newtypes first] - -- NB: try rewrite_newtype_app even when tc isn't a newtype; - -- the allows the possibility of having a newtype buried under - -- a synonym. Needed for e.g. T12067. - rewrite_newtype_app ty - - else -- For * a normal data type application - -- * data family application - -- we just recursively rewrite the arguments. - rewrite_ty_con_app tc tys } + | otherwise -- We just recursively rewrite the arguments. + -- See Note [Do not rewrite newtypes] + = rewrite_ty_con_app tc tys rewrite_one (FunTy { ft_af = vis, ft_mult = mult, ft_arg = ty1, ft_res = ty2 }) = do { arg_redn <- rewrite_one ty1 @@ -678,42 +664,12 @@ rewrite_vector ki roles tys fvs = tyCoVarsOfType ki {-# INLINE rewrite_vector #-} --- Rewrite a (potential) newtype application --- Precondition: the ambient EqRel is ReprEq --- Precondition: the type is a TyConApp --- See Note [Newtypes can blow the stack] -rewrite_newtype_app :: TcType -> RewriteM Reduction -rewrite_newtype_app ty@(TyConApp tc tys) - = do { rdr_env <- liftTcS getGlobalRdrEnvTcS - ; tf_envs <- liftTcS getFamInstEnvs - ; case (tcTopNormaliseNewTypeTF_maybe tf_envs rdr_env ty) of - Nothing -> -- Non-newtype or abstract newtype - rewrite_ty_con_app tc tys - - Just ((used_ctors, co), ty') -- co :: ty ~ ty' - -> do { liftTcS $ recordUsedGREs used_ctors - ; checkStackDepth ty - ; rewrite_reduction (Reduction co ty') } } - -rewrite_newtype_app other_ty = pprPanic "rewrite_newtype_app" (ppr other_ty) - -{- Note [Newtypes can blow the stack] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Suppose we have - - newtype X = MkX (Int -> X) - newtype Y = MkY (Int -> Y) - -and now wish to prove - - [W] X ~R Y -This Wanted will loop, expanding out the newtypes ever deeper looking -for a solid match or a solid discrepancy. Indeed, there is something -appropriate to this looping, because X and Y *do* have the same representation, -in the limit -- they're both (Fix ((->) Int)). However, no finitely-sized -coercion will ever witness it. This loop won't actually cause GHC to hang, -though, because we check our depth when unwrapping newtypes. +{- Note [Do not rewrite newtypes] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We flirted with unwrapping newtypes in the rewriter -- see GHC.Tc.Solver.Canonical +Note [Unwrap newtypes first]. But that turned out to be a bad idea because +of recursive newtypes, as that Note says. So be careful if you re-add it! Note [Rewriting synonyms] ~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== libraries/transformers ===================================== @@ -1 +1 @@ -Subproject commit ceff1dcd7893f7ab4abb6e66bcd248abd86c8886 +Subproject commit ef4fa181ebea77ac6997d392d1ef5a09524f06b2 ===================================== testsuite/driver/runtests.py ===================================== @@ -26,7 +26,9 @@ from pathlib import Path # So we import it here first, so that the testsuite doesn't appear to fail. import subprocess -from testutil import getStdout, Watcher, str_warn, str_info, print_table, shorten_metric_name +from concurrent.futures import ThreadPoolExecutor + +from testutil import getStdout, str_warn, str_info, print_table, shorten_metric_name from testglobals import getConfig, ghc_env, getTestRun, TestConfig, \ TestOptions, brokens, PerfMetric from my_typing import TestName @@ -151,7 +153,6 @@ config.broken_tests |= {TestName(t) for t in args.broken_test} if args.threads: config.threads = args.threads - config.use_threads = True if args.verbose is not None: config.verbose = args.verbose @@ -481,26 +482,28 @@ if config.list_broken: print('WARNING:', len(t.framework_failures), 'framework failures!') print('') else: - # completion watcher - watcher = Watcher(len(parallelTests)) - # Now run all the tests try: - for oneTest in parallelTests: - if stopping(): - break - oneTest(watcher) + with ThreadPoolExecutor(max_workers=config.threads) as executor: + for oneTest in parallelTests: + if stopping(): + break + oneTest(executor) - # wait for parallel tests to finish - if not stopping(): - watcher.wait() + # wait for parallel tests to finish + if not stopping(): + executor.shutdown(wait=True) # Run the following tests purely sequential - config.use_threads = False - for oneTest in aloneTests: - if stopping(): - break - oneTest(watcher) + with ThreadPoolExecutor(max_workers=1) as executor: + for oneTest in aloneTests: + if stopping(): + break + oneTest(executor) + + if not stopping(): + executor.shutdown(wait=True) + except KeyboardInterrupt: pass ===================================== testsuite/driver/testglobals.py ===================================== @@ -177,7 +177,6 @@ class TestConfig: # threads self.threads = 1 - self.use_threads = False # tests which should be considered to be broken during this testsuite # run. ===================================== testsuite/driver/testlib.py ===================================== @@ -36,10 +36,7 @@ from my_typing import * from threading import Timer from collections import OrderedDict -global pool_sema -if config.use_threads: - import threading - pool_sema = threading.BoundedSemaphore(value=config.threads) +import threading global wantToStop wantToStop = False @@ -84,12 +81,7 @@ def get_all_ways() -> Set[WayName]: # testdir_testopts after each test). global testopts_local -if config.use_threads: - testopts_local = threading.local() -else: - class TestOpts_Local: - pass - testopts_local = TestOpts_Local() # type: ignore +testopts_local = threading.local() def getTestOpts() -> TestOptions: return testopts_local.x @@ -1020,16 +1012,8 @@ parallelTests = [] aloneTests = [] allTestNames = set([]) # type: Set[TestName] -def runTest(watcher, opts, name: TestName, func, args): - if config.use_threads: - pool_sema.acquire() - t = threading.Thread(target=test_common_thread, - name=name, - args=(watcher, name, opts, func, args)) - t.daemon = False - t.start() - else: - test_common_work(watcher, name, opts, func, args) +def runTest(executor, opts, name: TestName, func, args): + return executor.submit(test_common_work, name, opts, func, args) # name :: String # setup :: [TestOpt] -> IO () @@ -1067,20 +1051,13 @@ def test(name: TestName, if name in config.broken_tests: myTestOpts.expect = 'fail' - thisTest = lambda watcher: runTest(watcher, myTestOpts, name, func, args) + thisTest = lambda executor: runTest(executor, myTestOpts, name, func, args) if myTestOpts.alone: aloneTests.append(thisTest) else: parallelTests.append(thisTest) allTestNames.add(name) -if config.use_threads: - def test_common_thread(watcher, name, opts, func, args): - try: - test_common_work(watcher, name, opts, func, args) - finally: - pool_sema.release() - def get_package_cache_timestamp() -> float: if config.package_conf_cache_file is None: return 0.0 @@ -1094,8 +1071,7 @@ do_not_copy = ('.hi', '.o', '.dyn_hi' , '.dyn_o', '.out' ,'.hi-boot', '.o-boot') # 12112 -def test_common_work(watcher: testutil.Watcher, - name: TestName, opts, +def test_common_work(name: TestName, opts, func, args) -> None: try: t.total_tests += 1 @@ -1214,8 +1190,6 @@ def test_common_work(watcher: testutil.Watcher, except Exception as e: framework_fail(name, None, 'Unhandled exception: ' + str(e)) - finally: - watcher.notify() def do_test(name: TestName, way: WayName, ===================================== testsuite/driver/testutil.py ===================================== @@ -5,8 +5,6 @@ import tempfile from pathlib import Path, PurePath from term_color import Color, colored -import threading - from my_typing import * @@ -125,24 +123,6 @@ else: else: os.symlink(str(src), str(dst)) -class Watcher(object): - def __init__(self, count: int) -> None: - self.pool = count - self.evt = threading.Event() - self.sync_lock = threading.Lock() - if count <= 0: - self.evt.set() - - def wait(self): - self.evt.wait() - - def notify(self): - self.sync_lock.acquire() - self.pool -= 1 - if self.pool <= 0: - self.evt.set() - self.sync_lock.release() - def memoize(f): """ A decorator to memoize a nullary function. ===================================== testsuite/tests/driver/T1959/test.T ===================================== @@ -1 +1 @@ -test('T1959', [extra_files(['B.hs', 'C.hs', 'D.hs', 'E1.hs', 'E2.hs']), js_broken(22261)], makefile_test, ['dotest']) +test('T1959', [extra_files(['B.hs', 'C.hs', 'D.hs', 'E1.hs', 'E2.hs']), js_broken(22374)], makefile_test, ['dotest']) ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -167,10 +167,10 @@ test('T5594', [ omit_ways(['ghci']), ], compile_and_run, ['T5594_c.c -no-hs-main']) -test('Capi_Ctype_001', [extra_files(['Capi_Ctype_A_001.hsc', 'capi_ctype_001.h', 'capi_ctype_001_c.c']), js_broken(22374)], +test('Capi_Ctype_001', [extra_files(['Capi_Ctype_A_001.hsc', 'capi_ctype_001.h', 'capi_ctype_001_c.c']), req_c], makefile_test, ['Capi_Ctype_001']) -test('Capi_Ctype_002', [extra_files(['Capi_Ctype_A_002.hsc', 'capi_ctype_002_A.h', 'capi_ctype_002_B.h']), js_broken(22374)], +test('Capi_Ctype_002', [extra_files(['Capi_Ctype_A_002.hsc', 'capi_ctype_002_A.h', 'capi_ctype_002_B.h']), req_c], makefile_test, ['Capi_Ctype_002']) test('ffi_parsing_001', [omit_ways(['ghci']), req_c], compile_and_run, ===================================== testsuite/tests/ghc-api/exactprint/T22919.hs ===================================== @@ -0,0 +1,2 @@ +module T22919 {- comment -} where +foo = 's' ===================================== testsuite/tests/ghc-api/exactprint/T22919.stderr ===================================== @@ -0,0 +1,116 @@ + +==================== Parser AST ==================== + +(L + { T22919.hs:1:1 } + (HsModule + (XModulePs + (EpAnn + (Anchor + { T22919.hs:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnModule (EpaSpan { T22919.hs:1:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { T22919.hs:1:29-33 }))] + (AnnList + (Nothing) + (Nothing) + (Nothing) + [] + []) + (Just + ((,) + { T22919.hs:3:1 } + { T22919.hs:2:7-9 }))) + (EpaCommentsBalanced + [(L + (Anchor + { T22919.hs:1:15-27 } + (UnchangedAnchor)) + (EpaComment + (EpaBlockComment + "{- comment -}") + { T22919.hs:1:8-13 }))] + [])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) + (Just + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:1:8-13 }) + {ModuleName: T22919})) + (Nothing) + [] + [(L + (SrcSpanAnn (EpAnn + (Anchor + { T22919.hs:2:1-9 } + (UnchangedAnchor)) + (AnnListItem + []) + (EpaComments + [])) { T22919.hs:2:1-9 }) + (ValD + (NoExtField) + (FunBind + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-3 }) + (Unqual + {OccName: foo})) + (MG + (FromSource) + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-9 }) + [(L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-9 }) + (Match + (EpAnn + (Anchor + { T22919.hs:2:1-9 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (FunRhs + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-3 }) + (Unqual + {OccName: foo})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (EpaComments + []) + [(L + (SrcSpanAnn + (EpAnnNotUsed) + { T22919.hs:2:5-9 }) + (GRHS + (EpAnn + (Anchor + { T22919.hs:2:5-9 } + (UnchangedAnchor)) + (GrhsAnn + (Nothing) + (AddEpAnn AnnEqual (EpaSpan { T22919.hs:2:5 }))) + (EpaComments + [])) + [] + (L + (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:7-9 }) + (HsLit + (EpAnn + (Anchor + { T22919.hs:2:7-9 } + (UnchangedAnchor)) + (NoEpAnns) + (EpaComments + [])) + (HsChar + (SourceText 's') + ('s'))))))] + (EmptyLocalBinds + (NoExtField)))))])))))])) ===================================== testsuite/tests/ghc-api/exactprint/Test20239.stderr ===================================== @@ -23,7 +23,14 @@ { Test20239.hs:8:1 } { Test20239.hs:7:34-63 }))) (EpaCommentsBalanced - [] + [(L + (Anchor + { Test20239.hs:3:1-28 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- | Leading Haddock Comment") + { Test20239.hs:1:18-22 }))] [(L (Anchor { Test20239.hs:7:34-63 } @@ -50,14 +57,7 @@ (AnnListItem []) (EpaComments - [(L - (Anchor - { Test20239.hs:3:1-28 } - (UnchangedAnchor)) - (EpaComment - (EpaLineComment - "-- | Leading Haddock Comment") - { Test20239.hs:1:18-22 }))])) { Test20239.hs:(4,1)-(6,86) }) + [])) { Test20239.hs:(4,1)-(6,86) }) (InstD (NoExtField) (DataFamInstD @@ -323,5 +323,5 @@ -Test20239.hs:4:15: error: [GHC-76037] +Test20239.hs:4:15: [GHC-76037] Not in scope: type constructor or class ‘Method’ ===================================== testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr ===================================== @@ -30,7 +30,15 @@ (EpaComment (EpaLineComment "-- leading comments") - { ZeroWidthSemi.hs:1:22-26 }))] + { ZeroWidthSemi.hs:1:22-26 })) + ,(L + (Anchor + { ZeroWidthSemi.hs:5:1-19 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- Function comment") + { ZeroWidthSemi.hs:3:1-19 }))] [(L (Anchor { ZeroWidthSemi.hs:8:1-58 } @@ -57,14 +65,7 @@ (AnnListItem []) (EpaComments - [(L - (Anchor - { ZeroWidthSemi.hs:5:1-19 } - (UnchangedAnchor)) - (EpaComment - (EpaLineComment - "-- Function comment") - { ZeroWidthSemi.hs:3:1-19 }))])) { ZeroWidthSemi.hs:6:1-5 }) + [])) { ZeroWidthSemi.hs:6:1-5 }) (ValD (NoExtField) (FunBind ===================================== testsuite/tests/ghc-api/exactprint/all.T ===================================== @@ -38,3 +38,4 @@ test('AddHiding1', ignore_stderr, makefile_test, ['AddHiding1']) test('AddHiding2', ignore_stderr, makefile_test, ['AddHiding2']) test('Test20239', normal, compile_fail, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments']) test('ZeroWidthSemi', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments']) +test('T22919', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments']) ===================================== testsuite/tests/parser/should_compile/DumpParsedAstComments.hs ===================================== @@ -4,6 +4,9 @@ -} module DumpParsedAstComments where +-- comment 1 for bar +-- comment 2 for bar +bar = 1 -- Other comment -- comment 1 for foo ===================================== testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr ===================================== @@ -21,8 +21,8 @@ []) (Just ((,) - { DumpParsedAstComments.hs:17:1 } - { DumpParsedAstComments.hs:16:17-23 }))) + { DumpParsedAstComments.hs:20:1 } + { DumpParsedAstComments.hs:19:17-23 }))) (EpaCommentsBalanced [(L (Anchor @@ -42,12 +42,20 @@ { DumpParsedAstComments.hs:1:1-28 })) ,(L (Anchor - { DumpParsedAstComments.hs:7:1-16 } + { DumpParsedAstComments.hs:7:1-20 } (UnchangedAnchor)) (EpaComment (EpaLineComment - "-- Other comment") - { DumpParsedAstComments.hs:5:30-34 }))] + "-- comment 1 for bar") + { DumpParsedAstComments.hs:5:30-34 })) + ,(L + (Anchor + { DumpParsedAstComments.hs:8:1-20 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- comment 2 for bar") + { DumpParsedAstComments.hs:7:1-20 }))] [])) (VirtualBraces (1)) @@ -62,55 +70,139 @@ [(L (SrcSpanAnn (EpAnn (Anchor - { DumpParsedAstComments.hs:(11,1)-(13,3) } + { DumpParsedAstComments.hs:9:1-7 } + (UnchangedAnchor)) + (AnnListItem + []) + (EpaComments + [])) { DumpParsedAstComments.hs:9:1-7 }) + (ValD + (NoExtField) + (FunBind + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-3 }) + (Unqual + {OccName: bar})) + (MG + (FromSource) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-7 }) + [(L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-7 }) + (Match + (EpAnn + (Anchor + { DumpParsedAstComments.hs:9:1-7 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (FunRhs + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-3 }) + (Unqual + {OccName: bar})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (EpaComments + []) + [(L + (SrcSpanAnn + (EpAnnNotUsed) + { DumpParsedAstComments.hs:9:5-7 }) + (GRHS + (EpAnn + (Anchor + { DumpParsedAstComments.hs:9:5-7 } + (UnchangedAnchor)) + (GrhsAnn + (Nothing) + (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:9:5 }))) + (EpaComments + [])) + [] + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:7 }) + (HsOverLit + (EpAnn + (Anchor + { DumpParsedAstComments.hs:9:7 } + (UnchangedAnchor)) + (NoEpAnns) + (EpaComments + [])) + (OverLit + (NoExtField) + (HsIntegral + (IL + (SourceText 1) + (False) + (1))))))))] + (EmptyLocalBinds + (NoExtField)))))]))))) + ,(L + (SrcSpanAnn (EpAnn + (Anchor + { DumpParsedAstComments.hs:(14,1)-(16,3) } (UnchangedAnchor)) (AnnListItem []) (EpaComments [(L (Anchor - { DumpParsedAstComments.hs:9:1-20 } + { DumpParsedAstComments.hs:10:1-16 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- Other comment") + { DumpParsedAstComments.hs:9:7 })) + ,(L + (Anchor + { DumpParsedAstComments.hs:12:1-20 } (UnchangedAnchor)) (EpaComment (EpaLineComment "-- comment 1 for foo") - { DumpParsedAstComments.hs:7:1-16 })) + { DumpParsedAstComments.hs:10:1-16 })) ,(L (Anchor - { DumpParsedAstComments.hs:10:1-20 } + { DumpParsedAstComments.hs:13:1-20 } (UnchangedAnchor)) (EpaComment (EpaLineComment "-- comment 2 for foo") - { DumpParsedAstComments.hs:9:1-20 - }))])) { DumpParsedAstComments.hs:(11,1)-(13,3) }) + { DumpParsedAstComments.hs:12:1-20 + }))])) { DumpParsedAstComments.hs:(14,1)-(16,3) }) (ValD (NoExtField) (FunBind (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:11:1-3 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:14:1-3 }) (Unqual {OccName: foo})) (MG (FromSource) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,1)-(13,3) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(14,1)-(16,3) }) [(L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,1)-(13,3) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(14,1)-(16,3) }) (Match (EpAnn (Anchor - { DumpParsedAstComments.hs:(11,1)-(13,3) } + { DumpParsedAstComments.hs:(14,1)-(16,3) } (UnchangedAnchor)) [] (EpaComments [])) (FunRhs (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:11:1-3 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:14:1-3 }) (Unqual {OccName: foo})) (Prefix) @@ -122,72 +214,72 @@ [(L (SrcSpanAnn (EpAnnNotUsed) - { DumpParsedAstComments.hs:(11,5)-(13,3) }) + { DumpParsedAstComments.hs:(14,5)-(16,3) }) (GRHS (EpAnn (Anchor - { DumpParsedAstComments.hs:(11,5)-(13,3) } + { DumpParsedAstComments.hs:(14,5)-(16,3) } (UnchangedAnchor)) (GrhsAnn (Nothing) - (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:11:5 }))) + (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:14:5 }))) (EpaComments [])) [] (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,7)-(13,3) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(14,7)-(16,3) }) (HsDo (EpAnn (Anchor - { DumpParsedAstComments.hs:(11,7)-(13,3) } + { DumpParsedAstComments.hs:(14,7)-(16,3) } (UnchangedAnchor)) (AnnList (Just (Anchor - { DumpParsedAstComments.hs:13:3 } + { DumpParsedAstComments.hs:16:3 } (UnchangedAnchor))) (Nothing) (Nothing) - [(AddEpAnn AnnDo (EpaSpan { DumpParsedAstComments.hs:11:7-8 }))] + [(AddEpAnn AnnDo (EpaSpan { DumpParsedAstComments.hs:14:7-8 }))] []) (EpaComments [(L (Anchor - { DumpParsedAstComments.hs:12:3-19 } + { DumpParsedAstComments.hs:15:3-19 } (UnchangedAnchor)) (EpaComment (EpaLineComment "-- normal comment") - { DumpParsedAstComments.hs:11:7-8 }))])) + { DumpParsedAstComments.hs:14:7-8 }))])) (DoExpr (Nothing)) (L (SrcSpanAnn (EpAnn (Anchor - { DumpParsedAstComments.hs:13:3 } + { DumpParsedAstComments.hs:16:3 } (UnchangedAnchor)) (AnnList (Just (Anchor - { DumpParsedAstComments.hs:13:3 } + { DumpParsedAstComments.hs:16:3 } (UnchangedAnchor))) (Nothing) (Nothing) [] []) (EpaComments - [])) { DumpParsedAstComments.hs:13:3 }) + [])) { DumpParsedAstComments.hs:16:3 }) [(L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:13:3 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:3 }) (BodyStmt (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:13:3 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:3 }) (HsOverLit (EpAnn (Anchor - { DumpParsedAstComments.hs:13:3 } + { DumpParsedAstComments.hs:16:3 } (UnchangedAnchor)) (NoEpAnns) (EpaComments @@ -206,45 +298,45 @@ ,(L (SrcSpanAnn (EpAnn (Anchor - { DumpParsedAstComments.hs:16:1-23 } + { DumpParsedAstComments.hs:19:1-23 } (UnchangedAnchor)) (AnnListItem []) (EpaComments [(L (Anchor - { DumpParsedAstComments.hs:15:1-20 } + { DumpParsedAstComments.hs:18:1-20 } (UnchangedAnchor)) (EpaComment (EpaLineComment "-- | Haddock comment") - { DumpParsedAstComments.hs:13:3 - }))])) { DumpParsedAstComments.hs:16:1-23 }) + { DumpParsedAstComments.hs:16:3 + }))])) { DumpParsedAstComments.hs:19:1-23 }) (ValD (NoExtField) (FunBind (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-4 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-4 }) (Unqual {OccName: main})) (MG (FromSource) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-23 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-23 }) [(L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-23 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-23 }) (Match (EpAnn (Anchor - { DumpParsedAstComments.hs:16:1-23 } + { DumpParsedAstComments.hs:19:1-23 } (UnchangedAnchor)) [] (EpaComments [])) (FunRhs (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-4 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-4 }) (Unqual {OccName: main})) (Prefix) @@ -256,42 +348,42 @@ [(L (SrcSpanAnn (EpAnnNotUsed) - { DumpParsedAstComments.hs:16:6-23 }) + { DumpParsedAstComments.hs:19:6-23 }) (GRHS (EpAnn (Anchor - { DumpParsedAstComments.hs:16:6-23 } + { DumpParsedAstComments.hs:19:6-23 } (UnchangedAnchor)) (GrhsAnn (Nothing) - (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:16:6 }))) + (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:19:6 }))) (EpaComments [])) [] (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-23 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:8-23 }) (HsApp (EpAnn (Anchor - { DumpParsedAstComments.hs:16:8-23 } + { DumpParsedAstComments.hs:19:8-23 } (UnchangedAnchor)) (NoEpAnns) (EpaComments [])) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-15 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:8-15 }) (HsVar (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-15 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:8-15 }) (Unqual {OccName: putStrLn})))) (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:17-23 }) + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:17-23 }) (HsLit (EpAnn (Anchor - { DumpParsedAstComments.hs:16:17-23 } + { DumpParsedAstComments.hs:19:17-23 } (UnchangedAnchor)) (NoEpAnns) (EpaComments ===================================== testsuite/tests/rts/all.T ===================================== @@ -258,7 +258,7 @@ test('T6006', [ omit_ways(prof_ways + ['ghci']), # needs it. compile_and_run, ['T6006_c.c -no-hs-main']) -test('T7037', js_broken(22374), makefile_test, ['T7037']) +test('T7037', req_c, makefile_test, ['T7037']) test('T7087', exit_code(1), compile_and_run, ['']) test('T7160', [ omit_ways(['nonmoving_thr', 'nonmoving_thr_ghc']) ===================================== testsuite/tests/safeHaskell/check/pkg01/all.T ===================================== @@ -32,7 +32,7 @@ test('safePkg01', normalise_version("array", "ghc-bignum", "bytestring", "base", "deepseq", "ghc-prim"), normalise_fun(normalise_errmsg), - js_skip], + js_broken(22356)], run_command, ['$MAKE -s --no-print-directory safePkg01 ' + make_args]) # Fail since we enable package trust ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -152,7 +152,7 @@ test('T7702', # allocation done by the plugin... but a regression allocates > 90mb collect_compiler_stats('peak_megabytes_allocated',70), when(opsys('mingw32'), fragile_for(16799, ['normal'])), - js_skip + req_interp ], compile, ['-v0 -package-db T7702plugin/pkg.T7702/local.package.conf -fplugin T7702Plugin -package T7702plugin ' + config.plugin_way_flags]) ===================================== testsuite/tests/typecheck/should_compile/T22924.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE FlexibleInstances #-} +module G where + +import Data.Functor.Const( Const ) +import Data.Coerce + +f :: Coercible (f a) a => Const a () -> Const (f a) () +f = coerce + ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -857,3 +857,4 @@ test('T22647', normal, compile, ['']) test('T19577', normal, compile, ['']) test('T22383', normal, compile, ['']) test('T21501', normal, compile, ['']) +test('T22924', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T22924a.hs ===================================== @@ -0,0 +1,9 @@ +module T22924a where + +import Data.Coerce + +newtype R = MkR [R] + +f :: a -> [R] +-- Should give a civilised error +f = coerce ===================================== testsuite/tests/typecheck/should_fail/T22924a.stderr ===================================== @@ -0,0 +1,11 @@ + +T22924a.hs:9:5: error: [GHC-10283] + • Couldn't match representation of type ‘a’ with that of ‘[R]’ + arising from a use of ‘coerce’ + ‘a’ is a rigid type variable bound by + the type signature for: + f :: forall a. a -> [R] + at T22924a.hs:7:1-13 + • In the expression: coerce + In an equation for ‘f’: f = coerce + • Relevant bindings include f :: a -> [R] (bound at T22924a.hs:9:1) ===================================== testsuite/tests/typecheck/should_fail/T22924b.hs ===================================== @@ -0,0 +1,10 @@ +module T22924b where + +import Data.Coerce + +newtype R = MkR [R] +newtype S = MkS [S] + +f :: R -> S +-- Blows the typechecker reduction stack +f = coerce ===================================== testsuite/tests/typecheck/should_fail/T22924b.stderr ===================================== @@ -0,0 +1,10 @@ + +T22924b.hs:10:5: error: + • Reduction stack overflow; size = 201 + When simplifying the following type: R + Use -freduction-depth=0 to disable this check + (any upper bound you could choose might fail unpredictably with + minor updates to GHC, so disabling the check is recommended if + you're sure that type checking should terminate) + • In the expression: coerce + In an equation for ‘f’: f = coerce ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -667,3 +667,5 @@ test('T22570', normal, compile_fail, ['']) test('T22645', normal, compile_fail, ['']) test('T20666', normal, compile_fail, ['']) test('T20666a', normal, compile_fail, ['']) +test('T22924a', normal, compile_fail, ['']) +test('T22924b', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a47ed9d202e7b26f3fda0dacda245f9e61f5c052...3bb8cc4d4841c4c050dd04986e0fe698f5616bab -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a47ed9d202e7b26f3fda0dacda245f9e61f5c052...3bb8cc4d4841c4c050dd04986e0fe698f5616bab You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 15:42:30 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 09 Feb 2023 10:42:30 -0500 Subject: [Git][ghc/ghc][wip/T22686] 43 commits: Bump transformers submodule to 0.6.0.6 Message-ID: <63e5146630e0a_2b039a5276036941a@gitlab.mail> Ben Gamari pushed to branch wip/T22686 at Glasgow Haskell Compiler / GHC Commits: 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - 72242964 by Ben Gamari at 2023-02-09T10:42:22-05:00 gitlab: Collect metadata about binary distributions Fixes #22686. - - - - - 30 changed files: - .gitlab-ci.yml - + .gitlab/bindist_metadata.py - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/CmmToLlvm/Mangler.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/List/SetOps.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Ticks.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bad48f74fae492f69cbc2a5826b0857dc191487e...7224296401d90df9f9198f6e195d597843f755c3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bad48f74fae492f69cbc2a5826b0857dc191487e...7224296401d90df9f9198f6e195d597843f755c3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 15:50:26 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Thu, 09 Feb 2023 10:50:26 -0500 Subject: [Git][ghc/ghc][ghc-9.2] 56 commits: Allow keywords which can be used as variables to be used with OverloadedDotSyntax Message-ID: <63e51642c3b9a_2b039a52724372413@gitlab.mail> Zubin pushed to branch ghc-9.2 at Glasgow Haskell Compiler / GHC Commits: 1b48378e by Matthew Pickering at 2023-01-23T13:37:08+05:30 Allow keywords which can be used as variables to be used with OverloadedDotSyntax There are quite a few keywords which are allowed to be used as variables. Such as "as", "dependency" etc. These weren't accepted by OverloadedDotSyntax. The fix is pretty simple, use the varid production rather than raw VARID. Fixes #20723 (cherry picked from commit 02372be119bd1a4e7099d2c7d5bb3de096e99409) - - - - - 6eaf0d3d by Andreas Klebinger at 2023-02-07T18:47:08+05:30 Fix #22425 - Broken eta-expansion over expensive work. This is the 9.2 backport of !9357 Through a mistake in the latest backport we started eta-expanding over expensive work by mistake. E.g. over <expensive> in code like: case x of A -> id B -> <expensive> We fix this by only eta-expanding over <expensive> if all other branches are headed by an oneShot lambda. In the long story of broken eta-expansion on 9.2/9.4 this is hopefully the last chapter. ------------------------- Metric Increase: CoOpt_Read T1969 parsing001 TcPlugin_RewritePerf LargeRecord ------------------------- (cherry picked from commit ce608479c7f40a9899a6448379d05861bee77b41) - - - - - fed9cff1 by Simon Peyton Jones at 2023-02-07T18:47:08+05:30 Add a missing varToCoreExpr in etaBodyForJoinPoint This subtle bug showed up when compiling a library with 9.4. See #22491. The bug is present in master, but it is hard to trigger; the new regression test T22491 fails in 9.4. The fix was easy: just add a missing varToCoreExpr in etaBodyForJoinPoint. The fix is definitely right though! I also did some other minor refatoring: * Moved the preInlineUnconditionally test in simplExprF1 to before the call to joinPointBinding_maybe, to avoid fruitless eta-expansion. * Added a boolean from_lam flag to simplNonRecE, to avoid two fruitless tests, and commented it a bit better. These refactorings seem to save 0.1% on compile-time allocation in perf/compiler; with a max saving of 1.4% in T9961 Metric Decrease: T9961 (cherry picked from commit afc2540daf6ca6baa09ab147b792da08d66d878c) - - - - - ce180d2f by Matthew Pickering at 2023-02-07T18:47:08+05:30 Typeable: Fix module locations of some definitions in GHC.Types There was some confusion in Data.Typeable about which module certain wired-in things were defined in. Just because something is wired-in doesn't mean it comes from GHC.Prim, in particular things like LiftedRep and RuntimeRep are defined in GHC.Types and that's the end of the story. Things like Int#, Float# etc are defined in GHC.Prim as they have no Haskell definition site at all so we need to generate type representations for them (which live in GHC.Types). Fixes #22510 (cherry picked from commit 1d3a8b8ec98e6eedf8943e19780ec374c2491e7f) - - - - - aac592f3 by Andreas Klebinger at 2023-02-07T18:47:08+05:30 Fix LitRubbish being applied to values. This fixes #19824 This is the 9.2 backport of commit 52ce8590ab18fb1fc99bd9aa24c016f786d7f7d1 (cherry picked from commit 2e02959ab40f2b67499aaffc29ee1dc9f0d48158) - - - - - 8aaf86f8 by Simon Peyton Jones at 2023-02-07T18:47:08+05:30 Fix unifier bug: failing to decompose over-saturated type family This simple patch fixes #22647 (cherry picked from commit 317f45c154f6fe25d50ef2f3febcc5883ff1b1ca) - - - - - 03da82af by Sebastian Graf at 2023-02-07T18:47:08+05:30 Handle shadowing in DmdAnal (#22718) Previously, when we had a shadowing situation like ```hs f x = ... -- demand signature <1L><1L> main = ... \f -> f 1 ... ``` we'd happily use the shadowed demand signature at the call site inside the lambda. Of course, that's wrong and solution is simply to remove the demand signature from the `AnalEnv` when we enter the lambda. This patch does so for all binding constructs Core. In #22718 the issue was caused by LetUp not shadowing away the existing demand signature for the let binder in the let body. The resulting absent error is fickle to reproduce; hence no reproduction test case. #17478 would help. Fixes #22718. It appears that TcPlugin_Rewrite regresses by ~40% on Darwin. It is likely that DmdAnal was exploiting ill-scoped analysis results. Metric increase ['bytes allocated'] (test_env=x86_64-darwin-validate): TcPlugin_Rewrite (cherry picked from commit e3fff7512bbf989386faaa1dccafdad1deabde84) - - - - - 7e47d0f5 by Zubin Duggal at 2023-02-07T18:47:09+05:30 Bump bytestring submodule to 0.11.4.0 - - - - - d130b39f by Andreas Klebinger at 2023-02-07T18:47:09+05:30 Only gc sparks locally when we can ensure marking is done. When performing GC without work stealing there was no guarantee that spark pruning was happening after marking of the sparks. This could cause us to GC live sparks under certain circumstances. Fixes #22528. (cherry picked from commit a1491c8791c57a64d94bc08d639d585815c8d4e2) - - - - - 5b2af591 by Ian-Woo Kim at 2023-02-07T18:47:09+05:30 Truncate eventlog event for large payload (#20221) RTS eventlog events for postCapsetVecEvent are truncated if payload is larger than EVENT_PAYLOAD_SIZE_MAX Previously, postCapsetVecEvent records eventlog event with payload of variable size larger than EVENT_PAYLOAD_SIZE_MAX (2^16) without any validation, resulting in corrupted data. For example, this happens when a Haskell binary is invoked with very long command line arguments exceeding 2^16 bytes (see #20221). Now we check the size of accumulated payload messages incrementally, and truncate the message just before the payload size exceeds EVENT_PAYLOAD_SIZE_MAX. RTS will warn the user with a message showing how many arguments are truncated. (cherry picked from commit 2057c77d08cb8422857d182a3691f98dccd0c7d6) - - - - - ec04fbed by Simon Peyton Jones at 2023-02-07T18:47:09+05:30 Make FloatIn robust to shadowing This MR fixes #22622. See the new Note [Shadowing and name capture] I did a bit of refactoring in sepBindsByDropPoint too. The bug doesn't manifest in HEAD, but it did show up in 9.4, so we should backport this patch to 9.4 (cherry picked from commit 6206cb9287f3f6e70c669660a646a65274870d2b) - - - - - a225dbb1 by Ben Gamari at 2023-02-07T18:47:09+05:30 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. (cherry picked from commit f891a442046d8a5ebf4d4777847880ce06752b18) - - - - - cf2da09a by Ben Gamari at 2023-02-07T18:47:09+05:30 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. (cherry picked from commit b13c6ea5d4b64841164f8cc58d6c6f3de390f2ed) - - - - - 09224b90 by Oleg Grenrus at 2023-02-07T18:47:09+05:30 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general (cherry picked from commit 1b812b6973a25cb1962e2fc543d2c4ed3cf31f3c) - - - - - 27f154f9 by Zubin Duggal at 2023-02-07T18:47:09+05:30 Document #22255 and #22468 in bugs.rst - - - - - c63a3e25 by Simon Peyton Jones at 2023-02-07T18:47:09+05:30 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 (cherry picked from commit 3d55d8ab51ece43c51055c43c9e7aba77cce46c0) - - - - - eadbbbcf by Simon Peyton Jones at 2023-02-07T18:47:09+05:30 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. (cherry picked from commit e193e53790dd5886feea3cf4c9c17625d188291b) - - - - - a090f5c3 by Sebastian Graf at 2023-02-07T18:47:09+05:30 DmdAnal: Don't panic in addCaseBndrDmd (#22039) Rather conservatively return Top. See Note [Untyped demand on case-alternative binders]. I also factored `addCaseBndrDmd` into two separate functions `scrutSubDmd` and `fieldBndrDmds`. Fixes #22039. (cherry picked from commit d2be80fd9b222963e8dd09a30f78c106e00da7f9) - - - - - 52e579b6 by Matthew Pickering at 2023-02-07T18:47:09+05:30 ApplicativeDo: Set pattern location before running exhaustiveness checker This improves the error messages of the exhaustiveness checker when checking statements which have been moved around with ApplicativeDo. Before: Test.hs:2:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 2 | let x = () | ^^^^^^^^^^ After: Test.hs:4:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 4 | ~(Just res1) <- seq x (pure $ Nothing @()) | Fixes #22483 (cherry picked from commit 74c767df770766d8d52e87b9ff7da10f94620a91) (cherry picked from commit 51c6051bcc405bc1dbddd450ade949acd70db6b8) - - - - - 96ab827a by Andreas Klebinger at 2023-02-07T18:47:09+05:30 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- (cherry picked from commit 08ba87200ff068aa37cac082e61ee7e2d534daf5) - - - - - 898ca9c6 by Matthew Pickering at 2023-02-07T18:47:09+05:30 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s (cherry picked from commit a960ca817d6ad0109ea6edda50da3902cc538e86) - - - - - 8e0c0da5 by Matthew Pickering at 2023-02-07T18:47:09+05:30 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. (cherry picked from commit 734847108420cf826a807c30ad54651659cf3a08) - - - - - 8ef4fec1 by Matthew Pickering at 2023-02-07T18:47:09+05:30 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes (cherry picked from commit 8c0ea25fb4a27d4729aabf73f4c00b912bb0c58d) - - - - - 2df830a1 by Cheng Shao at 2023-02-07T18:47:09+05:30 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. (cherry picked from commit c45a5fffef2c76efbf5d3a009c3f6d0244a63f0d) - - - - - 15d34a97 by Ben Gamari at 2023-02-07T18:47:09+05:30 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. (cherry picked from commit be417a47c7695998dea0adc05489a7b8838a78b6) - - - - - 34baa6e9 by Ben Gamari at 2023-02-07T18:47:10+05:30 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. (cherry picked from commit 30989d137b8f3a8fddbfd116e04b48f23c24f86c) - - - - - d5eea69c by Ben Gamari at 2023-02-07T18:47:10+05:30 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. (cherry picked from commit 7566fd9de38c67360c090f828923d41587af519c) - - - - - 8d846b8a by Ben Gamari at 2023-02-07T18:47:10+05:30 testsuite: Add regression test for #22798 (cherry picked from commit 2cb500a5ee1a31dfe1a2cdd71f175442026eb082) - - - - - 7262d71f by Zubin Duggal at 2023-02-07T18:47:10+05:30 hadrian: enable -haddock in perf flavour (#22734) - - - - - d966ed64 by Zubin Duggal at 2023-02-07T22:42:03+05:30 Bump version to GHC 9.2.6 and add changelog entries - - - - - 67ec973c by Zubin Duggal at 2023-02-08T05:42:32+05:30 Allow metric changes for 9.2.6 as baseline is from a release pipeline Metric Decrease: haddock.base haddock.Cabal haddock.compiler Metric Increase: ManyAlternatives ManyConstructors T10421 T10858 T12227 T12425 T12707 T13035 T13253 T13719 T15164 T16577 T18304 T18698a T18698b T3294 T5321FD T5642 T9203 T9233 T9630 T9872a T9872b T9872c T9872d T14697 T12545 - - - - - 804cd4c7 by Ben Gamari at 2023-02-08T14:54:08+05:30 rts: Introduce getNumCapabilities And ensure accesses to n_capabilities are atomic (although with relaxed ordering). This is necessary as RTS API callers may concurrently call into the RTS without holding a capability. (cherry picked from commit 70999283156f527c5aea6dee57a3d14989a9903a) - - - - - 04e9ae57 by Ben Gamari at 2023-02-08T14:54:16+05:30 nonmoving: Don't show occupancy if we didn't collect live words (cherry picked from commit fcd9794163f6ae7af8783676ee79e0b8e78167ba) - - - - - 67b43a14 by Ben Gamari at 2023-02-08T14:54:22+05:30 nonmoving: Refactor update remembered set initialization This avoids a lock inversion between the storage manager mutex and the stable pointer table mutex by not dropping the SM_MUTEX in nonmovingCollect. This requires quite a bit of rejiggering but it does seem like a better strategy. (cherry picked from commit 543cae0084a72ca767a443d857f9e65a5a79f71d) - - - - - 0c85bf30 by Ben Gamari at 2023-02-08T14:54:29+05:30 nonmoving: Fix style (cherry picked from commit b642ef1dc4cbe19c3479b2c014e7d1f7959f8e4a) - - - - - 3d26addf by Ben Gamari at 2023-02-08T14:54:43+05:30 Evac: Squash data race in eval_selector_chain (cherry picked from commit dd784b3b01f076fa7f5715150c53ad4c183ae79d) - - - - - 1c4ce072 by Ben Gamari at 2023-02-08T14:54:52+05:30 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Likely fixes the cause of #22264. (cherry picked from commit f8988a9c53ae73ff5b9c6008f467a7171e99c61f) - - - - - d377b9b4 by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. (cherry picked from commit a999f7b5b4b7316c088d7233a452fb33dc17646f) - - - - - f463d9e4 by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. (cherry picked from commit 48b89dba91640fa977d038ea5283019c73f1b18e) - - - - - c7f6cc07 by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Handle new closures in nonmovingIsNowAlive (cherry picked from commit 36ca160d0f199a688cf5fbc91d4bb92d2d4ea14e) - - - - - e2a81e2a by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. (cherry picked from commit 8b64aff0fa978c762dfae8df235dd2b2a340656a) - - - - - 8aceb849 by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. (cherry picked from commit dde67d6e32ecff0e400f98213d42ae790babac09) - - - - - 12761253 by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Don't push if nonmoving collector isn't enabled (cherry picked from commit 8adc1750c02e596b4014d2837b4eb3d76bd130f2) - - - - - 41c8db24 by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. (cherry picked from commit c620669651c52fd228af61040747dd7236c4ba2b) - - - - - cf1921ab by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Allow pinned gen0 objects to be WEAK keys (cherry picked from commit 3887132fcd20f0a1edfc9f7006bdbed2634e2a8d) - - - - - 639329fe by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. (cherry picked from commit cc75031b4d93d4565e0428cb5910d9b9a645485b) - - - - - 764145d7 by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Add missing no-op in busy-wait loop (cherry picked from commit 9f931a8801c84b8ae473f91349e144eebc73b415) - - - - - 71adc788 by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Move current segment array into Capability (cherry picked from commit 9d245c1baec91ee79d715062b127e487456d9c9e) - - - - - 85a080e9 by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. (cherry picked from commit 6bdce35cdd59112a8cb4a4a3b061e854ada3ff63) - - - - - 5721baa1 by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Fix unregisterised build (cherry picked from commit 6df2709e7215ea80d7267800e0318aee2a7c277f) - - - - - 98802ef8 by Ben Gamari at 2023-02-08T19:05:11+05:30 nonmoving: Avoid n_caps race (cherry picked from commit c00d6de815d4e125c1c4d8ff06549042f502f759) - - - - - d5291cff by Ben Gamari at 2023-02-08T19:05:11+05:30 relnotes: Mention various non-moving GC fixes - - - - - 06a4a65f by Zubin Duggal at 2023-02-08T19:05:11+05:30 testsuite: Mark T9405 as fixed on windows - - - - - fd636a4e by Matthew Pickering at 2023-02-09T16:25:04+05:30 Avoid repeated zonking and tidying of types in `relevant_bindings` The approach taking in this patch is that the tcl_bndrs in TcLclEnv are zonked and tidied eagerly, so that work can be shared across multiple calls to `relevant_bindings`. To test this patch I tried without the `keepThisHole` filter and the test finished quickly. Fixes #14766 - - - - - e222f33c by sheaf at 2023-02-09T16:27:01+05:30 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 (cherry picked from commit 9ee761bf02cdd11c955454a222c85971d95dce11) - - - - - 5383016c by Zubin Duggal at 2023-02-09T16:30:52+05:30 changelog: Add entries for #22913 and #14766 - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Parser.y - compiler/GHC/Rename/Bind.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/cbits/keepCAFsForGHCi.c - compiler/ghc.mk - configure.ac - docs/users_guide/9.2.1-notes.rst - + docs/users_guide/9.2.6-notes.rst - docs/users_guide/bugs.rst - docs/users_guide/release-notes.rst - hadrian/src/Settings/Flavours/Performance.hs - includes/rts/Threads.h - libraries/bytestring - libraries/ghc-bignum/gmp/gmp-tarballs - + m4/fp_ld_no_fixup_chains.m4 - rts/Capability.c - rts/Capability.h - rts/Messages.h The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/74ca6191fa0dbbe8cee3dc53741b8d59fbf16b09...5383016c78fe4b2555e0aae9248bea5b42f67a78 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/74ca6191fa0dbbe8cee3dc53741b8d59fbf16b09...5383016c78fe4b2555e0aae9248bea5b42f67a78 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 16:04:11 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 09 Feb 2023 11:04:11 -0500 Subject: [Git][ghc/ghc][wip/T22761] 33 commits: docs: 9.6 release notes for wasm backend Message-ID: <63e5197bed502_2b039a5271043213@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22761 at Glasgow Haskell Compiler / GHC Commits: 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - 5b47b082 by Simon Peyton Jones at 2023-02-09T16:04:47+00:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/CmmToLlvm/Mangler.hs - compiler/GHC/Core.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/List/SetOps.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3bc3f9cab9c36b27a96f340f225cc3fd8dbaa02f...5b47b0821fcea6d11aa73fe2faca145177b1b710 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3bc3f9cab9c36b27a96f340f225cc3fd8dbaa02f...5b47b0821fcea6d11aa73fe2faca145177b1b710 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 16:18:20 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 09 Feb 2023 11:18:20 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/generic-inlinable Message-ID: <63e51ccc3c1b2_2b039a527ec492263@gitlab.mail> Matthew Pickering pushed new branch wip/generic-inlinable at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/generic-inlinable You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 17:22:10 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 09 Feb 2023 12:22:10 -0500 Subject: [Git][ghc/ghc][wip/mp-backports-batch-2] 5 commits: Improve treatment of type applications in patterns Message-ID: <63e52bc2c0e25_2b039a526fc540124@gitlab.mail> Ben Gamari pushed to branch wip/mp-backports-batch-2 at Glasgow Haskell Compiler / GHC Commits: fcdf9f9b by Simon Peyton Jones at 2023-02-09T11:48:52-05:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 (cherry picked from commit 9f95db54e38b21782d058043abe42fd77abfb9ad) - - - - - bea77fc4 by Andreas Klebinger at 2023-02-09T12:05:36-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 (cherry picked from commit 382bd7dad9cd53254204f418190368667a127f64) - - - - - 31a90769 by Matthew Pickering at 2023-02-09T12:05:56-05:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. (cherry picked from commit cc72e71298ce7e8ef7a2263a531f96d777db1800) - - - - - 11686fb4 by Aaron Allen at 2023-02-09T12:06:01-05:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> (cherry picked from commit c31e87bbb13c0139b75acd234fd48eeb40cf50af) - - - - - 94844882 by Ben Gamari at 2023-02-09T12:06:40-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. (cherry picked from commit 6e52fcb915baa1acb38ad2b1f313e8e6a89899f5) - - - - - 30 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Driver/Config/Stg/Pipeline.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Types.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/Tc/Gen/Pat.hs - ghc/Main.hs - + testsuite/tests/gadt/T19847.hs - + testsuite/tests/gadt/T19847a.hs - + testsuite/tests/gadt/T19847a.stderr - testsuite/tests/gadt/all.T - testsuite/tests/ghci/should_run/all.T - testsuite/tests/plugins/all.T - + testsuite/tests/plugins/hooks-plugin/Hooks/LogPlugin.hs - testsuite/tests/plugins/hooks-plugin/Hooks/Plugin.hs → testsuite/tests/plugins/hooks-plugin/Hooks/MetaPlugin.hs - + testsuite/tests/plugins/hooks-plugin/Hooks/PhasePlugin.hs - testsuite/tests/plugins/hooks-plugin/hooks-plugin.cabal - testsuite/tests/plugins/plugins04.stderr - testsuite/tests/plugins/test-hooks-plugin.hs - + testsuite/tests/plugins/test-log-hooks-plugin.hs - + testsuite/tests/plugins/test-log-hooks-plugin.stderr - + testsuite/tests/plugins/test-phase-hooks-plugin.hs - + testsuite/tests/plugins/test-phase-hooks-plugin.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5809d9d7ba1845abdaede9bd8ad978026940359f...948448826d6913cdc133c33f054ef53485a47598 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5809d9d7ba1845abdaede9bd8ad978026940359f...948448826d6913cdc133c33f054ef53485a47598 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 19:08:08 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 09 Feb 2023 14:08:08 -0500 Subject: [Git][ghc/ghc][master] Update `Data.List.singleton` doc comment Message-ID: <63e54498b7319_2b039a9b5ac8056101d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - 1 changed file: - libraries/base/Data/OldList.hs Changes: ===================================== libraries/base/Data/OldList.hs ===================================== @@ -1511,7 +1511,7 @@ sortOn :: Ord b => (a -> b) -> [a] -> [a] sortOn f = map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x)) --- | Produce singleton list. +-- | Construct a list from a single element. -- -- >>> singleton True -- [True] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d9d0c28d3d9508d33e531d3d4ce854333a4df520 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d9d0c28d3d9508d33e531d3d4ce854333a4df520 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 19:08:41 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 09 Feb 2023 14:08:41 -0500 Subject: [Git][ghc/ghc][master] gitlab-template: Emphasize `user facing` label Message-ID: <63e544b9b639b_2b039a527245647bc@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - 1 changed file: - .gitlab/merge_request_templates/merge-request.md Changes: ===================================== .gitlab/merge_request_templates/merge-request.md ===================================== @@ -5,18 +5,19 @@ expectations. Also please answer the following question in your MR description:* **Where is the key part of this patch? That is, what should reviewers look at first?** -Please take a few moments to verify that your commits fulfill the following: +Please take a few moments to address the following points: - * [ ] are either individually buildable or squashed - * [ ] have commit messages which describe *what they do* - (referring to [Notes][notes] and tickets using `#NNNN` syntax when - appropriate) + * [ ] if your MR may break existing programs (e.g. touches `base` or causes the + compiler to reject programs), please describe the expected breakage and add + the ~"user facing" label. This will run ghc/head.hackage> to characterise + the effect of your change on Hackage. + * [ ] ensure that your commits are either individually buildable or squashed + * [ ] ensure that your commit messages describe *what they do* + (referring to tickets using `#NNNN` syntax when appropriate) * [ ] have added source comments describing your change. For larger changes you likely should add a [Note][notes] and cross-reference it from the relevant places. - * [ ] add a [testcase to the testsuite](https://gitlab.haskell.org/ghc/ghc/wikis/building/running-tests/adding). - * [ ] if your MR affects library interfaces (e.g. changes `base`) or affects whether GHC will accept user-written code, please add - the ~"user facing" label. + * [ ] add a [testcase to the testsuite][adding test]. * [ ] updates the users guide if applicable * [ ] mentions new features in the release notes for the next release @@ -29,3 +30,4 @@ no one has offerred review in a few days then please leave a comment mentioning @triagers. [notes]: https://gitlab.haskell.org/ghc/ghc/wikis/commentary/coding-style#comments-in-the-source-code +[adding test]: https://gitlab.haskell.org/ghc/ghc/wikis/building/running-tests/adding View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe9cd6ef1a07d214b76bc286875cbf15985d9a7b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe9cd6ef1a07d214b76bc286875cbf15985d9a7b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 19:47:14 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 09 Feb 2023 14:47:14 -0500 Subject: [Git][ghc/ghc][wip/T22686] gitlab: Collect metadata about binary distributions Message-ID: <63e54dc21730b_2b039a526705663c5@gitlab.mail> Ben Gamari pushed to branch wip/T22686 at Glasgow Haskell Compiler / GHC Commits: 6909823d by Ben Gamari at 2023-02-09T14:47:04-05:00 gitlab: Collect metadata about binary distributions Fixes #22686. - - - - - 4 changed files: - + .gitlab/bindist_metadata.py - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/bindist_metadata.py ===================================== @@ -0,0 +1,152 @@ +#!/usr/bin/env python3 + +import sys +import os +import shutil +import re +import ast +from pathlib import Path +import subprocess +import json +from typing import Dict, List, Set, Optional, NamedTuple + +def run(args: List[str]) -> str: + return subprocess.check_output(args, encoding='UTF-8') + +def parse_hadrian_cfg(cfg: str) -> Dict[str,str]: + res = {} + for l in cfg.split('\n'): + if l.startswith('#'): + continue + elif '=' in l: + i = l.find('=') + k = l[:i].strip() + v = l[i+1:].strip() + res[k] = v + + return res + +def get_ghc_info(ghc: Path) -> Dict[str,str]: + import ast + out = run([ghc, '--info']) + pairs = ast.literal_eval(out.strip()) + res = {} + for k,v in pairs: + if v == 'YES': + v = True + elif v == 'NO': + v = False + res[k] = v + + return res + +def get_dynamic_deps(objfile: Path) -> Set[Path]: + out = run(['ldd', objfile]) + return { Path(m.group(1)) for m in re.finditer('=> *([^ ]+)', out) } + +def get_configure_cmdline() -> str: + r = Path('config.log').read_text() + m = re.search(r' $ .+', r) + return m + +class Package(NamedTuple): + name: str + version: str + +def find_providing_package(f: Path) -> Optional[Package]: + if shutil.which('dpkg'): + out = run(['dpkg-query', '--search', f]).strip() + pkg,_file = out.split(':') + + out = run(['dpkg-query', '--show', pkg]).strip() + _pkg,version = out.split() + return Package(pkg, version) + elif shutil.which('rpm'): + out = run(['rpm', '-qf', f, '--queryformat=%{NAME} %{VERSION}\n']).strip() + pkg,version = out.split() + return Package(pkg, version) + elif shutil.which('apk'): + out = run(['apk', 'info', '--who-owns', f]).strip() + pkg = re.find('is owned by ([.+])', out) + + # Determining the version of an installed package is far too difficult; + # some day perhaps upstream will address + # https://gitlab.alpinelinux.org/alpine/apk-tools/-/issues/10704 + db = Path('/lib/apk/db/installed').read_text() + m = re.find(f'P:{pkg}\nV:([.+])\n', db) + version = m.group(1) + return Package(pkg, version) + else: + return None + +def main() -> None: + ghc = Path('_build/stage1/bin/ghc') + ghc_pkg = Path('_build/stage1/bin/ghc-pkg') + + metadata = {} + + system_config = Path('.') / 'hadrian' / 'cfg' / 'system.config' + cfg = parse_hadrian_cfg(system_config.read_text()) + + ###### + # GHC build configuration + ###### + metadata['ghc_version'] = cfg['project-version'] + metadata['git_commit_id'] = cfg['project-git-commit-id'] + metadata['tables_next_to_code'] = cfg['tables-next-to-code'] + metadata['unregisterised'] = cfg['ghc-unregisterised'] + metadata['build_triple'] = cfg['build-platform'] + metadata['host_triple'] = cfg['host-platform'] + metadata['target_triple'] = cfg['target-platform'] + metadata['build_flavour'] = os.environ.get('BUILD_FLAVOUR') + metadata['configure_cmdline'] = get_configure_cmdline() + + ###### + # Information about the bootstrapping environment + ###### + try: + lsb_release = run(['lsb_release']) + except: + lsb_release = 'unknown' + + metadata['bootstrap_environment'] = { + 'ghc': run([cfg['system-ghc'], '--version']).split('\n')[0], + 'cc': run([cfg['system-cc'], '--version']).split('\n')[0], + 'lsb_release': lsb_release, + } + + ###### + # Information about the bootstrapping environment's packages + ###### + dyn_deps = get_dynamic_deps(ghc) + print(dyn_deps) + deps = { + dep.name: find_providing_package(dep) + for dep in dyn_deps + if not dep.is_relative_to(Path('.').resolve()) + } + metadata['dynamic_deps'] = deps + + ###### + # The contents of the compiler's global package database + ###### + def call_ghc_pkg(args: List[str]) -> str: + return run([ghc_pkg, '--simple-output'] + args).strip() + + metadata['global_packages'] = { + pkg: { + 'version': call_ghc_pkg(['field', pkg, 'version']), + 'extra-libraries': call_ghc_pkg(['field', pkg, 'extra-libraries']).split(), + } + for pkg in call_ghc_pkg(['list', '--names-only']).split() + } + + ###### + # Information about the resulting compiler + ###### + metadata['inplace_ghc_info'] = get_ghc_info(ghc) + + json.dump(metadata, sys.stdout, indent=2) + +if __name__ == '__main__': + main() ===================================== .gitlab/ci.sh ===================================== @@ -478,6 +478,7 @@ function check_msys2_deps() { # Ensure that GHC on Windows doesn't have any dynamic dependencies on msys2 case "$(uname)" in MSYS_*|MINGW*) + info "Checking for unwanted msys2 dependencies..." sysroot="$(cygpath "$SYSTEMROOT")" PATH="$sysroot/System32:$sysroot;$sysroot/Wbem" $@ \ || fail "'$@' failed; there may be unwanted dynamic dependencies." @@ -584,6 +585,9 @@ function test_hadrian() { check_msys2_deps _build/stage1/bin/ghc --version check_release_build + info "Collecting binary distribution metadata..." + $TOP/.gitlab/bindist_metadata.py > metadata.json + # Ensure that statically-linked builds are actually static if [[ "${BUILD_FLAVOUR}" = *static* ]]; then bad_execs="" ===================================== .gitlab/gen_ci.hs ===================================== @@ -680,6 +680,7 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } { junitReport = "junit.xml" , expireIn = "2 weeks" , artifactPaths = [binDistName arch opsys buildConfig ++ ".tar.xz" + ,"metadata.json" ,"junit.xml"] , artifactsWhen = ArtifactsAlways } ===================================== .gitlab/jobs.yaml ===================================== @@ -11,6 +11,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -73,6 +74,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -131,6 +133,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -189,6 +192,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -252,6 +256,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -311,6 +316,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate+llvm.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -370,6 +376,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -429,6 +436,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -494,6 +502,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -555,6 +564,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-cross_wasm32-wasi-release+fully_static.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -616,6 +626,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -677,6 +688,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -740,6 +752,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -801,6 +814,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -864,6 +878,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-centos7-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -924,6 +939,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -983,6 +999,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1042,6 +1059,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1102,6 +1120,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1161,6 +1180,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1220,6 +1240,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1279,6 +1300,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1338,6 +1360,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1399,6 +1422,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1460,6 +1484,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1522,6 +1547,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1581,6 +1607,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb9-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1640,6 +1667,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1701,6 +1729,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1763,6 +1792,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-validate+debug_info.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1824,6 +1854,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-rocky8-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1884,6 +1915,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu18_04-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1943,6 +1975,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu20_04-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2001,6 +2034,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-int_native-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2060,6 +2094,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2120,6 +2155,7 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-darwin-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2184,6 +2220,7 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-linux-deb10-release+no_split_sections.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2244,6 +2281,7 @@ "expire_in": "1 year", "paths": [ "ghc-i386-linux-deb9-release+no_split_sections.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2304,6 +2342,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-darwin-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2370,6 +2409,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2434,6 +2474,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2498,6 +2539,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-centos7-release+no_split_sections.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2559,6 +2601,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2619,6 +2662,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release+debug_info.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2679,6 +2723,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2739,6 +2784,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb9-release+no_split_sections.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2799,6 +2845,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2861,6 +2908,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release+debug_info.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2923,6 +2971,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2986,6 +3035,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-rocky8-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3047,6 +3097,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu18_04-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3107,6 +3158,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu20_04-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3166,6 +3218,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-int_native-release+no_split_sections.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3226,6 +3279,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-release+no_split_sections.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3287,6 +3341,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3351,6 +3406,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3411,6 +3467,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-cross_wasm32-wasi-release+fully_static.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3471,6 +3528,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3533,6 +3591,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3591,6 +3650,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3650,6 +3710,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3709,6 +3770,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3767,6 +3829,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3825,6 +3888,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3883,6 +3947,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3944,6 +4009,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -4004,6 +4070,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -4065,6 +4132,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -4124,6 +4192,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6909823d6a26a7b112cc0728e54fe1e266b69af4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6909823d6a26a7b112cc0728e54fe1e266b69af4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 21:16:44 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 09 Feb 2023 16:16:44 -0500 Subject: [Git][ghc/ghc][wip/T22404] 41 commits: docs: 9.6 release notes for wasm backend Message-ID: <63e562bce4fee_2b039a526fc5763cf@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - b1dc97f4 by Simon Peyton Jones at 2023-02-09T21:17:37+00:00 Work in progress on #22404 Very much not ready! - - - - - 7b40b7ec by Sebastian Graf at 2023-02-09T21:17:37+00:00 Partition into OneOccs and ManyOccs - - - - - 518253be by Simon Peyton Jones at 2023-02-09T21:17:37+00:00 Wibbles - - - - - 9121225d by Simon Peyton Jones at 2023-02-09T21:17:37+00:00 Refactor WithTailJoinDetails - - - - - aba7d696 by Simon Peyton Jones at 2023-02-09T21:17:37+00:00 Wibbles - - - - - 9449c08d by Simon Peyton Jones at 2023-02-09T21:17:37+00:00 Wibbles - - - - - 031234f1 by Simon Peyton Jones at 2023-02-09T21:17:37+00:00 Major wibbles - - - - - 73d5dc16 by Simon Peyton Jones at 2023-02-09T21:17:37+00:00 Wibble - - - - - 4964bebf by Simon Peyton Jones at 2023-02-09T21:17:37+00:00 Vital fix to alt_env - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/CmmToLlvm/Mangler.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/List/SetOps.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Env.hs - compiler/GHC/IfaceToCore.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b5a78a03c56111645a4fd12383200bf78ee49002...4964bebf10e8ae18cac0e7319931eeb391b8a4d6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b5a78a03c56111645a4fd12383200bf78ee49002...4964bebf10e8ae18cac0e7319931eeb391b8a4d6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 22:40:07 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Thu, 09 Feb 2023 17:40:07 -0500 Subject: [Git][ghc/ghc][wip/T21909] 16 commits: JS: avoid head/tail and unpackFS Message-ID: <63e576475c73e_2b039a1fb8a168586048@gitlab.mail> Apoorv Ingle pushed to branch wip/T21909 at Glasgow Haskell Compiler / GHC Commits: c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - 3b15c57c by Apoorv Ingle at 2023-02-09T16:37:23-06:00 Fixes #21909 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag in `CDictCan.cc_pend_sc`. Pending Givens get a fuel of 3 to start of with while Wanted constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints. Added tests T21909, T21909b - - - - - 3baf2787 by Apoorv Ingle at 2023-02-09T16:39:09-06:00 Change `qci_pend_sc` from `Bool` to `ExpansionFuel` - - - - - e3ce9db4 by Apoorv Ingle at 2023-02-09T16:39:21-06:00 abstract default fuel into constants - - - - - 46ad0da9 by Apoorv Ingle at 2023-02-09T16:39:21-06:00 added note [SimplifyInfer and UndecidableSuperClasses] - - - - - 4cb98f17 by Apoorv Ingle at 2023-02-09T16:39:21-06:00 make expansion fuel a dynamic flag - - - - - 30 changed files: - .gitlab/merge_request_templates/merge-request.md - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Rename/Bind.hs - compiler/GHC/Settings/Constants.hs - compiler/GHC/StgToJS/Printer.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - libraries/base/Data/OldList.hs - libraries/transformers - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/driver/testutil.py - testsuite/tests/driver/T1959/test.T - testsuite/tests/ffi/should_run/all.T - + testsuite/tests/ghc-api/exactprint/T22919.hs - + testsuite/tests/ghc-api/exactprint/T22919.stderr - testsuite/tests/ghc-api/exactprint/Test20239.stderr - testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr - testsuite/tests/ghc-api/exactprint/all.T - testsuite/tests/parser/should_compile/DumpParsedAstComments.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2d07c9b94c542671e0a19c86d0d3a65e64cbeaf4...4cb98f17e040e0c22ea24ebe3f431090d127dd20 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2d07c9b94c542671e0a19c86d0d3a65e64cbeaf4...4cb98f17e040e0c22ea24ebe3f431090d127dd20 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 22:54:15 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 09 Feb 2023 17:54:15 -0500 Subject: [Git][ghc/ghc][wip/T22404] Comments Message-ID: <63e57997ebffe_2b039a52724588674@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 626ea35b by Simon Peyton Jones at 2023-02-09T22:55:06+00:00 Comments - - - - - 1 changed file: - compiler/GHC/Core/Opt/OccurAnal.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -595,10 +595,119 @@ This showed up when compiling Control.Concurrent.Chan.getChanContents. Hence the transitive rule_fv_env stuff described in Note [Rules and loop breakers]. ------------------------------------------------------------- Note [Occurrence analysis for join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -ToDo: addresses #22404. +Consider these two somewhat artificial programs (#22404) + + Program (P1) Program (P2) + ------------------------------ ------------------------------------- + let v = in let v = in + join j = case v of (a,b) -> a + in case x of in case x of + A -> case v of (a,b) -> a A -> j + B -> case v of (a,b) -> a B -> j + C -> case v of (a,b) -> b C -> case v of (a,b) -> b + D -> [] D -> [] + +In (P1), `v` gets allocated, as a thunk, every time this code is executed. But +notice that `v` occurs at most once in any case branch; the occurrence analyser +spots this and returns a OneOcc{ occ_n_br = 3 } for `v`. Then the code in +GHC.Core.Opt.Simplify.Utils.postInlineUnconditionally inlines `v` at its three +use sites, and discards the let-binding. That way, we avoid allocating `v` in +the A,B,C branches (though we still compute it of course), and branch D +doesn't involve at all. This sometimes makes a Really Big +Difference. + +In (P2) we have shared the common RHS of A, B, in a join point `j`. We would +like to inline `v1 in just the same way as in (P1). But if we "andUDs" +the usage from j's RHS and its body, we'll get ManyOccs for `v`. Important +optimisation lost! + +The occurrence analyser therefore has clever code that behaves just as +if you inlined `j` at all its call sites. Here is a tricky variant (P3) +to keep in mind: + join j = case v of (a,b) -> a + in case f v of + A -> j + B -> j + C -> [] +If you mentally inline `j` you'll see that `v` is used twice on the path +through A, so it should have ManyOcc. Bear this caes in mind! + +* We treat /non-recursive/ join points specially. Recursive join points + are treated like any other letrec, as before. Moreover, we only + deal with /pre-existing/ non-recursive join points, not the ones + that we discover for the first time in this sweep of the + occurrence analyser. + +* In occ_env, the new (occ_join_points :: IdEnv UsageDetails) maps + each in-scope non-recursive join point, such as `j` above, to + a "zeroed form" of its RHS's usage details. The "zeroed form" + * deletes ManyOccs + * maps a OneOcc to OneOcc{ occ_n_br = 0 } + In our example, occ_join_points will be extended with + [j :-> [v :-> OneOcc{occ_n_br=0}]] + See addJoinPoint. + +* At an occurence of a join point, we do everything as normal, but add in the + UsageDetails from the occ_join_points. See mkOneOcc. + +* At the NonRec binding of the join point, we use `orUDs`, not `andUDs` to + combine the usage from the RHS with the usage from the body. + +Here are the consequences + +* Because of the perhaps-surprising OneOcc{occ_n_br=0} idea of the zeroed + form, the occ_n_br field of a OneOcc binder still counts the number of + /actual lexical occurrences/ of the variable. In Program P2, for example, + `v` will end up with OneOcc{occ_n_br=2}, not occ_n_br=3. There are two + lexical occurrences of `v`! + +* In the tricky (P3) we'll get an `andUDs` of + * OneOcc{occ_n_br=0} from the occurrences of `j`) + * OneOcc{occ_n_br=1} from the (f v) + These are `andUDs` together, and hence `addOccInfo`, and hence + `v` gets ManyOccs, just as it should. Clever! + +There are a couple of tricky wrinkles + +(W1) Consider this example which shadows `j`: + join j = rhs in + in case x of { K j -> ..j..; ... } + Clearly when we come to the pattern `K j` we must drop the `j` + entry in occ_join_points. + + This is done by `drop_shadowed_joins` in `addInScope`. + +(W2) Consider this example which shadows `v`: + join j = ...v... + in case x of { K v -> ..j..; ... } + + We can't make j's occurrences in the K alternative give rise to an + occurrence of `v` (via occ_join_points), because it'll just be deleted by + the `K v` pattern. Yikes. This is rare because shadowing is rare, but + it definitely can happen. Solution: when bringing `v` into scope at + the `K v` pattern, chuck out of occ_join_points any elements whose + UsageDetails mentions `v`. Instead, just `andUDs` all that usage in + right here. + + This is done by `add_bad_joins`` in `addInScope`; we use + `partitionVarEnv` to identify the `bad_joins` (the ones whose + UsageDetails mention the newly bound variables); then for any of /those/ + that are actually mentioned in the body, use `andUDs` to add their + UsageDetails to the returned UsageDetails. Tricky! + +(W3) Consider this example, which shadows `j`, but this time in an argument + join j = rhs + in f (case x of { K j -> ...; ... }) + We can zap the occ_join_points when looking at the argument, because + `j` can't posibly occur -- it's a join point! And the smaller + occ_join_points is, the better. Smaller to look up in, less faffing + in (W2). + + This is done in setRhsCtxt. + +Wrinkles (W1) and (W2) are very similar to Note [Binder swap] (BS3). Note [Finding join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2701,7 +2810,8 @@ setRhsCtxt :: OccEncl -> OccEnv -> OccEnv setRhsCtxt ctxt !env = env { occ_encl = ctxt , occ_one_shots = [] - , occ_join_points = emptyVarEnv -- See XXXNoteXXX [OccAnal for join points] + , occ_join_points = emptyVarEnv + -- See (W3) of Note [Occurrence analysis for join points] } addOneShots :: OccEnv -> [OneShots] -> (OccEnv, [OneShots]) @@ -2733,7 +2843,7 @@ addInScope env@(OccEnv { occ_join_points = join_points }) = env { occ_bs_env = swap_env `delVarEnvList` bndrs } drop_shadowed_joins :: OccEnv -> OccEnv - -- See Note [Occurrence analysis for join points] + -- See Note [Occurrence analysis for join points] wrinkle (W1) drop_shadowed_joins env = env { occ_join_points = good_joins `delVarEnvList` bndrs} fix_up_uds :: WithUsageDetails a -> WithUsageDetails a @@ -2744,7 +2854,17 @@ addInScope env@(OccEnv { occ_join_points = join_points }) where trimmed_uds = uds `delDetails` bndrs with_co_var_occs = trimmed_uds `addManyOccs` coVarOccs bndrs - with_joins = nonDetStrictFoldUFM andUDs with_co_var_occs bad_joins + with_joins = add_bad_joins with_co_var_occs + + add_bad_joins :: UsageDetails -> UsageDetails + add_bad_joins uds = nonDetStrictFoldUFM_Directly add_bad_join uds bad_joins + + add_bad_join :: Unique -> UsageDetails -- Bad join and its usage details + -> UsageDetails -> UsageDetails + -- See Note [Occurrence analysis for join points] wrinkle (W2) + add_bad_join uniq bad_join_uds uds + | uniq `elemUFM_Directly` ud_env uds = uds `andUDs` bad_join_uds + | otherwise = uds (bad_joins, good_joins) = partitionVarEnv bad_join_rhs join_points @@ -2752,11 +2872,15 @@ addInScope env@(OccEnv { occ_join_points = join_points }) bad_join_rhs (UD { ud_env = rhs_usage }) = any (`elemVarEnv` rhs_usage) bndrs addJoinPoint :: OccEnv -> Id -> UsageDetails -> OccEnv -addJoinPoint env bndr rhs_uds@(UD { ud_env = rhs_occs }) - = env { occ_join_points = extendVarEnv (occ_join_points env) bndr join_occ_uds } +addJoinPoint env bndr rhs_uds + = env { occ_join_points = extendVarEnv (occ_join_points env) + bndr (mkZeroedForm rhs_uds) } + +mkZeroedForm :: UsageDetails -> UsageDetails +-- See Note [Occurrence analysis for join points] for "zeroed form" +mkZeroedForm rhs_uds@(UD { ud_env = rhs_occs }) + = emptyDetails { ud_env = mapMaybeUFM_Directly do_one rhs_occs } where - join_occ_uds = emptyDetails { ud_env = mapMaybeUFM_Directly do_one rhs_occs } - do_one :: Unique -> OccInfo -> Maybe OccInfo do_one key occ = case doZappingByUnique rhs_uds key occ of ManyOccs {} -> Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/626ea35bbc51f7ce1a63f6b8fa6aff49539307b4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/626ea35bbc51f7ce1a63f6b8fa6aff49539307b4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 22:54:21 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Thu, 09 Feb 2023 17:54:21 -0500 Subject: [Git][ghc/ghc][wip/T21909] 3 commits: abstract default fuel into constants Message-ID: <63e5799d2df1b_2b039a527605888f1@gitlab.mail> Apoorv Ingle pushed to branch wip/T21909 at Glasgow Haskell Compiler / GHC Commits: 493ba50a by Apoorv Ingle at 2023-02-09T16:53:49-06:00 abstract default fuel into constants - - - - - 8e8e1162 by Apoorv Ingle at 2023-02-09T16:53:56-06:00 added note [SimplifyInfer and UndecidableSuperClasses] - - - - - 55922356 by Apoorv Ingle at 2023-02-09T16:53:56-06:00 make expansion fuel a dynamic flag - - - - - 5 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings/Constants.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Types/Constraint.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -517,6 +517,12 @@ data DynFlags = DynFlags { reductionDepth :: IntWithInf, -- ^ Typechecker maximum stack depth solverIterations :: IntWithInf, -- ^ Number of iterations in the constraints solver -- Typically only 1 is needed + givensFuel :: Int, -- ^ Number of layers of superclass expansion + -- Should be < solverIterations + wantedsFuel :: Int, -- ^ Number of layers of superclass expansion + -- Should be < givensFuel + qcsFuel :: Int, -- ^ Number of layers of superclass expansion + -- Should be < givensFuel homeUnitId_ :: UnitId, -- ^ Target home unit-id homeUnitInstanceOf_ :: Maybe UnitId, -- ^ Id of the unit to instantiate @@ -1148,6 +1154,9 @@ defaultDynFlags mySettings = mainFunIs = Nothing, reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH, solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS, + givensFuel = mAX_GIVENS_FUEL, + wantedsFuel = mAX_WANTEDS_FUEL, + qcsFuel = mAX_QC_FUEL, homeUnitId_ = mainUnitId, homeUnitInstanceOf_ = Nothing, @@ -2732,6 +2741,12 @@ dynamic_flags_deps = [ (intSuffix (\n d -> d { reductionDepth = treatZeroAsInf n })) , make_ord_flag defFlag "fconstraint-solver-iterations" (intSuffix (\n d -> d { solverIterations = treatZeroAsInf n })) + , make_ord_flag defFlag "fgivens-expansion-fuel" + (intSuffix (\n d -> d { givensFuel = n })) + , make_ord_flag defFlag "fwanteds-expansion-fuel" + (intSuffix (\n d -> d { wantedsFuel = n })) + , make_ord_flag defFlag "fqcs-expansion-fuel" + (intSuffix (\n d -> d { qcsFuel = n })) , (Deprecated, defFlag "fcontext-stack" (intSuffixM (\n d -> do { deprecate $ "use -freduction-depth=" ++ show n ++ " instead" ===================================== compiler/GHC/Settings/Constants.hs ===================================== @@ -30,6 +30,21 @@ mAX_REDUCTION_DEPTH = 200 mAX_SOLVER_ITERATIONS :: Int mAX_SOLVER_ITERATIONS = 4 +-- | In case of loopy quantified costraints constraints, +-- how many times should we allow superclass expansions +mAX_QC_FUEL :: Int +mAX_QC_FUEL = 3 + +-- | In case of loopy wanted constraints, +-- how many times should we allow superclass expansions +mAX_WANTEDS_FUEL :: Int +mAX_WANTEDS_FUEL = 1 + +-- | In case of loopy given constraints, +-- how many times should we allow superclass expansions +mAX_GIVENS_FUEL :: Int +mAX_GIVENS_FUEL = 3 + wORD64_SIZE :: Int wORD64_SIZE = 8 ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -2370,6 +2370,43 @@ superclasses. In that case we check whether the new Wanteds actually led to any new unifications, and iterate the implications only if so. -} +{- Note [SimplifyInfer with UndecidableSuperClasses] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In some cases while infering the type of a term well typed term, it is necessary to ensure +we limit the wanted superclass expansions. +Expanding them too many times will lead to the given constraint superclass expansion +not being able solve all the wanted constraints, by entering a perpetual loop and erroring out on +too many solver iterations. Expanding them too little will not give us a simplified type signature. + +Consider the program (T21909) + + class C [a] => C a where + foo :: a -> Int + + bar :: C a => a -> Int + bar x = foolocal x + where + foolocal x = foo x + +In the current implimentation +We infer the type of foolocal to be `(C a) => a -> Int` +and then simplify it to `(C a, C [[a]]) => a -> Int` + +This indeed is not simplification per say, but we are in UndecidableSuperclass case +so we cannot guarantee simplification of contraints. What we aim for is for the +the solver to not to loop unnecessarily generating more wanted constraints than +in can solve in `maybe_simplify_again`. + +If we did not limit the wanteds superclass expansion we would simplify the type signature of +foolocal as `(C a , C [[a]], C[[[[a]]]], C[[[[a]]]], C [[[[[[[[a]]]]]]]]) => a -> Int` +Definitely _worse_ than above type! + +The current limit the expansion of such recursive wanted constraints to 1 (mAX_WANTEDS_FUEL), +and limit the expansion of recursive given constraints to 3 (mAX_GIVENS_FUEL). + +-} + + solveNestedImplications :: Bag Implication -> TcS (Bag Implication) -- Precondition: the TcS inerts may contain unsolved simples which have ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -58,7 +58,7 @@ import Control.Monad import Data.Maybe ( isJust, isNothing ) import Data.List ( zip4 ) import GHC.Types.Basic - +import GHC.Driver.Session ( DynFlags, givensFuel, wantedsFuel, qcsFuel ) import qualified Data.Semigroup as S import Data.Bifunctor ( bimap ) @@ -127,14 +127,16 @@ canonicalize (CEqCan { cc_ev = ev canNC :: CtEvidence -> TcS (StopOrContinue Ct) canNC ev = case classifyPredType pred of - ClassPred cls tys -> do traceTcS "canEvNC:cls" (ppr cls <+> ppr tys) - canClassNC ev cls tys + ClassPred cls tys -> do dflags <- getDynFlags + traceTcS "canEvNC:cls" (ppr cls <+> ppr tys) + canClassNC dflags ev cls tys EqPred eq_rel ty1 ty2 -> do traceTcS "canEvNC:eq" (ppr ty1 $$ ppr ty2) canEqNC ev eq_rel ty1 ty2 IrredPred {} -> do traceTcS "canEvNC:irred" (ppr pred) canIrred ev - ForAllPred tvs th p -> do traceTcS "canEvNC:forall" (ppr pred) - canForAllNC ev tvs th p + ForAllPred tvs th p -> do dflags <- getDynFlags + traceTcS "canEvNC:forall" (ppr pred) + canForAllNC dflags ev tvs th p where pred = ctEvPred ev @@ -147,13 +149,14 @@ canNC ev = ************************************************************************ -} -canClassNC :: CtEvidence -> Class -> [Type] -> TcS (StopOrContinue Ct) +canClassNC :: DynFlags -> CtEvidence -> Class -> [Type] -> TcS (StopOrContinue Ct) -- "NC" means "non-canonical"; that is, we have got here -- from a NonCanonical constraint, not from a CDictCan -- Precondition: EvVar is class evidence -canClassNC ev cls tys +canClassNC dflags ev cls tys | isGiven ev -- See Note [Eagerly expand given superclasses] - = do { sc_cts <- mkStrictSuperClasses defaultFuelGivens ev [] [] cls tys + = do { let gf = givensFuel dflags + ; sc_cts <- mkStrictSuperClasses gf ev [] [] cls tys ; emitWork sc_cts ; canClass ev cls tys doNotExpand } @@ -188,8 +191,8 @@ canClassNC ev cls tys = canClass ev cls tys fuel where - fuel | cls_has_scs = defaultFuelWanteds - | otherwise = doNotExpand + fuel | cls_has_scs = wantedsFuel dflags + | otherwise = doNotExpand cls_has_scs = not (null (classSCTheta cls)) loc = ctEvLoc ev orig = ctLocOrigin loc @@ -729,6 +732,7 @@ canIrred :: CtEvidence -> TcS (StopOrContinue Ct) -- Precondition: ty not a tuple and no other evidence form canIrred ev = do { let pred = ctEvPred ev + ; dflags <- getDynFlags ; traceTcS "can_pred" (text "IrredPred = " <+> ppr pred) ; (redn, rewriters) <- rewrite ev pred ; rewriteEvidence rewriters ev redn `andWhenContinue` \ new_ev -> @@ -737,7 +741,7 @@ canIrred ev -- Code is like the canNC, except -- that the IrredPred branch stops work ; case classifyPredType (ctEvPred new_ev) of - ClassPred cls tys -> canClassNC new_ev cls tys + ClassPred cls tys -> canClassNC dflags new_ev cls tys EqPred eq_rel ty1 ty2 -> -- IrredPreds have kind Constraint, so -- cannot become EqPreds pprPanic "canIrred: EqPred" @@ -746,7 +750,7 @@ canIrred ev -- should never leave a meta-var filled -- in with a polytype. This is #18987. do traceTcS "canEvNC:forall" (ppr pred) - canForAllNC ev tvs th p + canForAllNC dflags ev tvs th p IrredPred {} -> continueWith $ mkIrredCt IrredShapeReason new_ev } } @@ -828,21 +832,23 @@ type signature. -} -canForAllNC :: CtEvidence -> [TyVar] -> TcThetaType -> TcPredType +canForAllNC :: DynFlags -> CtEvidence -> [TyVar] -> TcThetaType -> TcPredType -> TcS (StopOrContinue Ct) -canForAllNC ev tvs theta pred +canForAllNC dflags ev tvs theta pred | isGiven ev -- See Note [Eagerly expand given superclasses] , Just (cls, tys) <- cls_pred_tys_maybe - = do { sc_cts <- mkStrictSuperClasses defaultFuelGivens ev tvs theta cls tys + = do { let gf = givensFuel dflags + ; sc_cts <- mkStrictSuperClasses gf ev tvs theta cls tys ; emitWork sc_cts ; canForAll ev doNotExpand } | otherwise - = canForAll ev fuel + = do { let qcf = qcsFuel dflags + fuel | isJust cls_pred_tys_maybe = qcf + | otherwise = doNotExpand + ; canForAll ev fuel } where - fuel | isJust cls_pred_tys_maybe = defaultFuelQC - | otherwise = doNotExpand cls_pred_tys_maybe = getClassPredTys_maybe pred canForAll :: CtEvidence -> ExpansionFuel -> TcS (StopOrContinue Ct) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -11,8 +11,7 @@ module GHC.Tc.Types.Constraint ( -- Canonical constraints Xi, Ct(..), Cts, - ExpansionFuel, doNotExpand, defaultFuelGivens, defaultFuelWanteds, - defaultFuelQC, consumeFuel, + ExpansionFuel, doNotExpand, consumeFuel, emptyCts, andCts, andManyCts, pprCts, singleCt, listToCts, ctsElts, consCts, snocCts, extendCtsList, isEmptyCts, @@ -140,8 +139,6 @@ import Data.Word ( Word8 ) import Data.List ( intersperse ) - - {- ************************************************************************ * * @@ -194,14 +191,11 @@ type Xi = TcType type Cts = Bag Ct -- | Says how many layers of superclasses can we expand. --- see T21909 +-- see Note [SimplifyIner with UndecidableSuperClasses] type ExpansionFuel = Int -doNotExpand, defaultFuelGivens, defaultFuelWanteds, defaultFuelQC :: ExpansionFuel +doNotExpand :: ExpansionFuel -- Do not expand superclasses anymore doNotExpand = 0 -defaultFuelQC = 1 -defaultFuelWanteds = 1 -defaultFuelGivens = 3 consumeFuel :: ExpansionFuel -> ExpansionFuel consumeFuel fuel = fuel - 1 @@ -216,6 +210,7 @@ data Ct cc_pend_sc :: ExpansionFuel -- See Note [The superclass story] in GHC.Tc.Solver.Canonical + -- See Note [SimplifyInfer with UndecidableSuperClasses] in GHC.Tc.Solver -- n > 0 <=> (a) cc_class has superclasses -- (b) we have not (yet) explored those superclasses } @@ -287,9 +282,11 @@ data QCInst -- A much simplified version of ClsInst -- Always Given , qci_tvs :: [TcTyVar] -- The tvs , qci_pred :: TcPredType -- The ty - , qci_pend_sc :: ExpansionFuel -- Same as cc_pend_sc flag in CDictCan - -- Invariants: qci_pend_sc > 0 => qci_pred is a ClassPred - -- the superclasses are unexplored + , qci_pend_sc :: ExpansionFuel -- Invariants: qci_pend_sc > 0 => qci_pred is a ClassPred + -- and the superclasses are unexplored + -- Same as cc_pend_sc flag in CDictCan + -- See Note [SimplifyInfer with UndecidableSuperClasses] + -- in GHC.Tc.Solver } instance Outputable QCInst where @@ -915,7 +912,7 @@ isPendingScDict _ = False pendingScDict_maybe :: Ct -> Maybe Ct -- Says whether this is a CDictCan with cc_pend_sc has fuel left, --- AND if so flips the flag +-- AND if so exhausts the fuel so that they are not expanded again pendingScDict_maybe ct@(CDictCan { cc_pend_sc = n }) | n > 0 = Just (ct { cc_pend_sc = doNotExpand }) | otherwise = Nothing @@ -944,12 +941,12 @@ superClassesMightHelp (WC { wc_simple = simples, wc_impl = implics }) is_ip _ = False getPendingWantedScs :: Cts -> ([Ct], Cts) --- [Ct] has original fuel while Cts has fuel exhausted +-- in the return values [Ct] has original fuel while Cts has fuel exhausted getPendingWantedScs simples = mapAccumBagL get [] simples where - get acc ct | Just ct' <- pendingScDict_maybe ct - = (ct:acc, ct') + get acc ct | Just ct_exhausted <- pendingScDict_maybe ct + = (ct:acc, ct_exhausted) | otherwise = (acc, ct) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4cb98f17e040e0c22ea24ebe3f431090d127dd20...55922356bdb0c29b20ca15839d1a82037389ce9d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4cb98f17e040e0c22ea24ebe3f431090d127dd20...55922356bdb0c29b20ca15839d1a82037389ce9d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Feb 9 23:08:33 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Thu, 09 Feb 2023 18:08:33 -0500 Subject: [Git][ghc/ghc][wip/T21909] 2 commits: added note [SimplifyInfer and UndecidableSuperClasses] Message-ID: <63e57cf11680_2b039a1fb8a1685896f7@gitlab.mail> Apoorv Ingle pushed to branch wip/T21909 at Glasgow Haskell Compiler / GHC Commits: 8fa8b551 by Apoorv Ingle at 2023-02-09T17:08:07-06:00 added note [SimplifyInfer and UndecidableSuperClasses] - - - - - a1e7ebe9 by Apoorv Ingle at 2023-02-09T17:08:18-06:00 make expansion fuel a dynamic flag - - - - - 4 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Types/Constraint.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -517,6 +517,12 @@ data DynFlags = DynFlags { reductionDepth :: IntWithInf, -- ^ Typechecker maximum stack depth solverIterations :: IntWithInf, -- ^ Number of iterations in the constraints solver -- Typically only 1 is needed + givensFuel :: Int, -- ^ Number of layers of superclass expansion + -- Should be < solverIterations + wantedsFuel :: Int, -- ^ Number of layers of superclass expansion + -- Should be < givensFuel + qcsFuel :: Int, -- ^ Number of layers of superclass expansion + -- Should be < givensFuel homeUnitId_ :: UnitId, -- ^ Target home unit-id homeUnitInstanceOf_ :: Maybe UnitId, -- ^ Id of the unit to instantiate @@ -1148,6 +1154,9 @@ defaultDynFlags mySettings = mainFunIs = Nothing, reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH, solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS, + givensFuel = mAX_GIVENS_FUEL, + wantedsFuel = mAX_WANTEDS_FUEL, + qcsFuel = mAX_QC_FUEL, homeUnitId_ = mainUnitId, homeUnitInstanceOf_ = Nothing, @@ -2732,6 +2741,12 @@ dynamic_flags_deps = [ (intSuffix (\n d -> d { reductionDepth = treatZeroAsInf n })) , make_ord_flag defFlag "fconstraint-solver-iterations" (intSuffix (\n d -> d { solverIterations = treatZeroAsInf n })) + , make_ord_flag defFlag "fgivens-expansion-fuel" + (intSuffix (\n d -> d { givensFuel = n })) + , make_ord_flag defFlag "fwanteds-expansion-fuel" + (intSuffix (\n d -> d { wantedsFuel = n })) + , make_ord_flag defFlag "fqcs-expansion-fuel" + (intSuffix (\n d -> d { qcsFuel = n })) , (Deprecated, defFlag "fcontext-stack" (intSuffixM (\n d -> do { deprecate $ "use -freduction-depth=" ++ show n ++ " instead" ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -2372,11 +2372,11 @@ any new unifications, and iterate the implications only if so. {- Note [SimplifyInfer with UndecidableSuperClasses] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In some cases while infering the type of a term well typed term, it is necessary to make sure -we tactfully limit the wanted superclass expansions. +In some cases while infering the type of a term well typed term, it is necessary to ensure +we limit the wanted superclass expansions. Expanding them too many times will lead to the given constraint superclass expansion -no not be able to catch up causing a perpetual loop and erroring out on -too many solver iterations. Expanding them too little might not give us enough to solve them. +not being able solve all the wanted constraints, by entering a perpetual loop and erroring out on +too many solver iterations. Expanding them too little will not give us a simplified type signature. Consider the program (T21909) @@ -2388,24 +2388,21 @@ Consider the program (T21909) where foolocal x = foo x -We infer the type of foolocal to be `a -> Int` with an unsolved [W] C a -after canonicalization and simpliying the constraint we get - [W] C a (1) - [W] C [a] (1) +In the current implimentation +We infer the type of foolocal to be `(C a) => a -> Int` +and then simplify it to `(C a, C [[a]]) => a -> Int` +This indeed is not simplification per say, but we are in UndecidableSuperclass case +so we cannot guarantee simplification of contraints. What we aim for is for the +the solver to not to loop unnecessarily generating more wanted constraints than +in can solve in `maybe_simplify_again`. -and we then try to simplify the constraint `C a` via `solveWanteds` in `simplifyInfer` -We have an implication wanted constraint: - [G] C a0:sk (nonCanonical, lvl 1) => [W] C a1 (NonCanonical lvl 2) - -we first canonicalize C a0 and then simplify it and obtain at (level 1) - [G] C a0 (3, lvl 1) - [G] C [a0] (3 lvl 1) - -we then step in the implication to canonicalize and `C a1` to obtain - [W] C a1 (1, lvl 2) - [W] C [a1] (1, lvl 2) +If we did not limit the wanteds superclass expansion we would simplify the type signature of +foolocal as `(C a , C [[a]], C[[[[a]]]], C[[[[a]]]], C [[[[[[[[a]]]]]]]]) => a -> Int` +Definitely _worse_ than above type! +The current limit the expansion of such recursive wanted constraints to 1 (mAX_WANTEDS_FUEL), +and limit the expansion of recursive given constraints to 3 (mAX_GIVENS_FUEL). -} ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -58,7 +58,7 @@ import Control.Monad import Data.Maybe ( isJust, isNothing ) import Data.List ( zip4 ) import GHC.Types.Basic - +import GHC.Driver.Session ( DynFlags, givensFuel, wantedsFuel, qcsFuel ) import qualified Data.Semigroup as S import Data.Bifunctor ( bimap ) @@ -127,14 +127,16 @@ canonicalize (CEqCan { cc_ev = ev canNC :: CtEvidence -> TcS (StopOrContinue Ct) canNC ev = case classifyPredType pred of - ClassPred cls tys -> do traceTcS "canEvNC:cls" (ppr cls <+> ppr tys) - canClassNC ev cls tys + ClassPred cls tys -> do dflags <- getDynFlags + traceTcS "canEvNC:cls" (ppr cls <+> ppr tys) + canClassNC dflags ev cls tys EqPred eq_rel ty1 ty2 -> do traceTcS "canEvNC:eq" (ppr ty1 $$ ppr ty2) canEqNC ev eq_rel ty1 ty2 IrredPred {} -> do traceTcS "canEvNC:irred" (ppr pred) canIrred ev - ForAllPred tvs th p -> do traceTcS "canEvNC:forall" (ppr pred) - canForAllNC ev tvs th p + ForAllPred tvs th p -> do dflags <- getDynFlags + traceTcS "canEvNC:forall" (ppr pred) + canForAllNC dflags ev tvs th p where pred = ctEvPred ev @@ -147,13 +149,14 @@ canNC ev = ************************************************************************ -} -canClassNC :: CtEvidence -> Class -> [Type] -> TcS (StopOrContinue Ct) +canClassNC :: DynFlags -> CtEvidence -> Class -> [Type] -> TcS (StopOrContinue Ct) -- "NC" means "non-canonical"; that is, we have got here -- from a NonCanonical constraint, not from a CDictCan -- Precondition: EvVar is class evidence -canClassNC ev cls tys +canClassNC dflags ev cls tys | isGiven ev -- See Note [Eagerly expand given superclasses] - = do { sc_cts <- mkStrictSuperClasses defaultFuelGivens ev [] [] cls tys + = do { let gf = givensFuel dflags + ; sc_cts <- mkStrictSuperClasses gf ev [] [] cls tys ; emitWork sc_cts ; canClass ev cls tys doNotExpand } @@ -188,8 +191,8 @@ canClassNC ev cls tys = canClass ev cls tys fuel where - fuel | cls_has_scs = defaultFuelWanteds - | otherwise = doNotExpand + fuel | cls_has_scs = wantedsFuel dflags + | otherwise = doNotExpand cls_has_scs = not (null (classSCTheta cls)) loc = ctEvLoc ev orig = ctLocOrigin loc @@ -729,6 +732,7 @@ canIrred :: CtEvidence -> TcS (StopOrContinue Ct) -- Precondition: ty not a tuple and no other evidence form canIrred ev = do { let pred = ctEvPred ev + ; dflags <- getDynFlags ; traceTcS "can_pred" (text "IrredPred = " <+> ppr pred) ; (redn, rewriters) <- rewrite ev pred ; rewriteEvidence rewriters ev redn `andWhenContinue` \ new_ev -> @@ -737,7 +741,7 @@ canIrred ev -- Code is like the canNC, except -- that the IrredPred branch stops work ; case classifyPredType (ctEvPred new_ev) of - ClassPred cls tys -> canClassNC new_ev cls tys + ClassPred cls tys -> canClassNC dflags new_ev cls tys EqPred eq_rel ty1 ty2 -> -- IrredPreds have kind Constraint, so -- cannot become EqPreds pprPanic "canIrred: EqPred" @@ -746,7 +750,7 @@ canIrred ev -- should never leave a meta-var filled -- in with a polytype. This is #18987. do traceTcS "canEvNC:forall" (ppr pred) - canForAllNC ev tvs th p + canForAllNC dflags ev tvs th p IrredPred {} -> continueWith $ mkIrredCt IrredShapeReason new_ev } } @@ -828,21 +832,23 @@ type signature. -} -canForAllNC :: CtEvidence -> [TyVar] -> TcThetaType -> TcPredType +canForAllNC :: DynFlags -> CtEvidence -> [TyVar] -> TcThetaType -> TcPredType -> TcS (StopOrContinue Ct) -canForAllNC ev tvs theta pred +canForAllNC dflags ev tvs theta pred | isGiven ev -- See Note [Eagerly expand given superclasses] , Just (cls, tys) <- cls_pred_tys_maybe - = do { sc_cts <- mkStrictSuperClasses defaultFuelGivens ev tvs theta cls tys + = do { let gf = givensFuel dflags + ; sc_cts <- mkStrictSuperClasses gf ev tvs theta cls tys ; emitWork sc_cts ; canForAll ev doNotExpand } | otherwise - = canForAll ev fuel + = do { let qcf = qcsFuel dflags + fuel | isJust cls_pred_tys_maybe = qcf + | otherwise = doNotExpand + ; canForAll ev fuel } where - fuel | isJust cls_pred_tys_maybe = defaultFuelQC - | otherwise = doNotExpand cls_pred_tys_maybe = getClassPredTys_maybe pred canForAll :: CtEvidence -> ExpansionFuel -> TcS (StopOrContinue Ct) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -11,8 +11,7 @@ module GHC.Tc.Types.Constraint ( -- Canonical constraints Xi, Ct(..), Cts, - ExpansionFuel, doNotExpand, defaultFuelGivens, defaultFuelWanteds, - defaultFuelQC, consumeFuel, + ExpansionFuel, doNotExpand, consumeFuel, emptyCts, andCts, andManyCts, pprCts, singleCt, listToCts, ctsElts, consCts, snocCts, extendCtsList, isEmptyCts, @@ -139,9 +138,6 @@ import Data.List.NonEmpty ( NonEmpty ) import Data.Word ( Word8 ) import Data.List ( intersperse ) -import GHC.Settings.Constants ( mAX_QC_FUEL, mAX_WANTEDS_FUEL, mAX_GIVENS_FUEL ) - - {- ************************************************************************ @@ -195,14 +191,11 @@ type Xi = TcType type Cts = Bag Ct -- | Says how many layers of superclasses can we expand. --- see Note [SimplifyIner with UndecidableSuperClasses] +-- see Note [SimplifyInfer with UndecidableSuperClasses] type ExpansionFuel = Int -doNotExpand, defaultFuelGivens, defaultFuelWanteds, defaultFuelQC :: ExpansionFuel -doNotExpand = 0 -- Do not expand superclasses anymore -defaultFuelQC = mAX_QC_FUEL -- default fuel for quantified constraints -defaultFuelWanteds = mAX_WANTEDS_FUEL -- default fuel for wanted constraints -defaultFuelGivens = mAX_GIVENS_FUEL -- default fule for given constraints +doNotExpand :: ExpansionFuel -- Do not expand superclasses anymore +doNotExpand = 0 consumeFuel :: ExpansionFuel -> ExpansionFuel consumeFuel fuel = fuel - 1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/55922356bdb0c29b20ca15839d1a82037389ce9d...a1e7ebe91fcc68e5d9857535d8b352a1b95725ae -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/55922356bdb0c29b20ca15839d1a82037389ce9d...a1e7ebe91fcc68e5d9857535d8b352a1b95725ae You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 10 01:41:01 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 09 Feb 2023 20:41:01 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Update `Data.List.singleton` doc comment Message-ID: <63e5a0ad21f68_2b039a527105940c0@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - 8f209f5c by Simon Peyton Jones at 2023-02-09T20:40:43-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - cd4ba2d7 by Rebecca Turner at 2023-02-09T20:40:46-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 16 changed files: - .gitlab/merge_request_templates/merge-request.md - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/Types/Id.hs - libraries/base/Data/OldList.hs - + testsuite/tests/simplCore/should_compile/T22761.hs - + testsuite/tests/simplCore/should_compile/T22761a.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== .gitlab/merge_request_templates/merge-request.md ===================================== @@ -5,18 +5,19 @@ expectations. Also please answer the following question in your MR description:* **Where is the key part of this patch? That is, what should reviewers look at first?** -Please take a few moments to verify that your commits fulfill the following: +Please take a few moments to address the following points: - * [ ] are either individually buildable or squashed - * [ ] have commit messages which describe *what they do* - (referring to [Notes][notes] and tickets using `#NNNN` syntax when - appropriate) + * [ ] if your MR may break existing programs (e.g. touches `base` or causes the + compiler to reject programs), please describe the expected breakage and add + the ~"user facing" label. This will run ghc/head.hackage> to characterise + the effect of your change on Hackage. + * [ ] ensure that your commits are either individually buildable or squashed + * [ ] ensure that your commit messages describe *what they do* + (referring to tickets using `#NNNN` syntax when appropriate) * [ ] have added source comments describing your change. For larger changes you likely should add a [Note][notes] and cross-reference it from the relevant places. - * [ ] add a [testcase to the testsuite](https://gitlab.haskell.org/ghc/ghc/wikis/building/running-tests/adding). - * [ ] if your MR affects library interfaces (e.g. changes `base`) or affects whether GHC will accept user-written code, please add - the ~"user facing" label. + * [ ] add a [testcase to the testsuite][adding test]. * [ ] updates the users guide if applicable * [ ] mentions new features in the release notes for the next release @@ -29,3 +30,4 @@ no one has offerred review in a few days then please leave a comment mentioning @triagers. [notes]: https://gitlab.haskell.org/ghc/ghc/wikis/commentary/coding-style#comments-in-the-source-code +[adding test]: https://gitlab.haskell.org/ghc/ghc/wikis/building/running-tests/adding ===================================== compiler/GHC/Core.hs ===================================== @@ -1300,16 +1300,19 @@ data Unfolding df_args :: [CoreExpr] -- Args of the data con: types, superclasses and methods, } -- in positional order - | CoreUnfolding { -- An unfolding for an Id with no pragma, - -- or perhaps a NOINLINE pragma - -- (For NOINLINE, the phase, if any, is in the - -- InlinePragInfo for this Id.) - uf_tmpl :: CoreExpr, -- Template; occurrence info is correct - uf_src :: UnfoldingSource, -- Where the unfolding came from - uf_is_top :: Bool, -- True <=> top level binding - uf_cache :: UnfoldingCache, -- Cache of flags computable from the expr - -- See Note [Tying the 'CoreUnfolding' knot] - uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template. + | CoreUnfolding { -- An unfolding for an Id with no pragma, + -- or perhaps a NOINLINE pragma + -- (For NOINLINE, the phase, if any, is in the + -- InlinePragInfo for this Id.) + uf_tmpl :: CoreExpr, -- The unfolding itself (aka "template") + -- Always occ-analysed; + -- See Note [OccInfo in unfoldings and rules] + + uf_src :: UnfoldingSource, -- Where the unfolding came from + uf_is_top :: Bool, -- True <=> top level binding + uf_cache :: UnfoldingCache, -- Cache of flags computable from the expr + -- See Note [Tying the 'CoreUnfolding' knot] + uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template. } -- ^ An unfolding with redundant cached information. Parameters: -- @@ -1637,14 +1640,37 @@ change was requested by Roman, but it seems to make sense. Note [OccInfo in unfoldings and rules] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In unfoldings and rules, we guarantee that the template is occ-analysed, -so that the occurrence info on the binders is correct. This is important, -because the Simplifier does not re-analyse the template when using it. If -the occurrence info is wrong - - We may get more simplifier iterations than necessary, because - once-occ info isn't there - - More seriously, we may get an infinite loop if there's a Rec - without a loop breaker marked +In unfoldings and rules, we guarantee that the template is occ-analysed, so +that the occurrence info on the binders is correct. That way, when the +Simplifier inlines an unfolding, it doesn't need to occ-analysis it first. +(The Simplifier is designed to simplify occ-analysed expressions.) + +Given this decision it's vital that we do *always* do it. + +* If we don't, we may get more simplifier iterations than necessary, + because once-occ info isn't there + +* More seriously, we may get an infinite loop if there's a Rec without a + loop breaker marked. + +* Or we may get code that mentions variables not in scope: #22761 + e.g. Suppose we have a stable unfolding : \y. let z = p+1 in 3 + Then the pre-simplifier occ-anal will occ-anal the unfolding + (redundantly perhaps, but we need its free vars); this will not report + the use of `p`; so p's binding will be discarded, and yet `p` is still + mentioned. + + Better to occ-anal the unfolding at birth, which will drop the + z-binding as dead code. (Remember, it's the occurrence analyser that + drops dead code.) + +* Another example is #8892: + \x -> letrec { f = ...g...; g* = f } in body + where g* is (for some strange reason) the loop breaker. If we don't + occ-anal it when reading it in, we won't mark g as a loop breaker, and we + may inline g entirely in body, dropping its binding, and leaving the + occurrence in f out of scope. This happened in #8892, where the unfolding + in question was a DFun unfolding. ************************************************************************ ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -3088,8 +3088,15 @@ etaExpandToJoinPointRule join_arity rule@(Rule { ru_bndrs = bndrs, ru_rhs = rhs | need_args < 0 = pprPanic "etaExpandToJoinPointRule" (ppr join_arity $$ ppr rule) | otherwise - = rule { ru_bndrs = bndrs ++ new_bndrs, ru_args = args ++ new_args - , ru_rhs = new_rhs } + = rule { ru_bndrs = bndrs ++ new_bndrs + , ru_args = args ++ new_args + , ru_rhs = new_rhs } + -- new_rhs really ought to be occ-analysed (see GHC.Core Note + -- [OccInfo in unfoldings and rules]), but it makes a module loop to + -- do so; it doesn't happen often; and it doesn't really matter if + -- the outer binders have bogus occurrence info; and new_rhs won't + -- have dead code if rhs didn't. + where need_args = join_arity - length args (new_bndrs, new_rhs) = etaBodyForJoinPoint need_args rhs ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -2165,6 +2165,17 @@ So we have a fast-path that keeps the old tree if the occ_bs_env is empty. This just saves a bit of allocation and reconstruction; not a big deal. +This fast path exposes a tricky cornder, though (#22761). Supose we have + Unfolding = \x. let y = foo in x+1 +which includes a dead binding for `y`. In occAnalUnfolding we occ-anal +the unfolding and produce /no/ occurrences of `foo` (since `y` is +dead). But if we discard the occ-analysed syntax tree (which we do on +our fast path), and use the old one, we still /have/ an occurrence of +`foo` -- and that can lead to out-of-scope variables (#22761). + +Solution: always keep occ-analysed trees in unfoldings and rules, so they +have no dead code. See Note [OccInfo in unfoldings and rules] in GHC.Core. + Note [Cascading inlines] ~~~~~~~~~~~~~~~~~~~~~~~~ By default we use an rhsCtxt for the RHS of a binding. This tells the ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -1065,7 +1065,7 @@ subst_id_bndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) -- See Note [Bangs in the Simplifier] !id1 = uniqAway in_scope old_id !id2 = substIdType env id1 - !id3 = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding + !id3 = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding -- and fragile OccInfo !new_id = adjust_type id3 ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -319,14 +319,14 @@ simplLazyBind :: SimplEnv -> TopLevelFlag -> RecFlag -> InId -> OutId -- Binder, both pre-and post simpl -- Not a JoinId - -- The OutId has IdInfo, except arity, unfolding + -- The OutId has IdInfo (notably RULES), + -- except arity, unfolding -- Ids only, no TyVars -> InExpr -> SimplEnv -- The RHS and its environment -> SimplM (SimplFloats, SimplEnv) -- Precondition: the OutId is already in the InScopeSet of the incoming 'env' -- Precondition: not a JoinId -- Precondition: rhs obeys the let-can-float invariant --- NOT used for JoinIds simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se = assert (isId bndr ) assertPpr (not (isJoinId bndr)) (ppr bndr) $ @@ -398,48 +398,45 @@ simplJoinBind env is_rec cont old_bndr new_bndr rhs rhs_se ; completeBind env (BC_Join is_rec cont) old_bndr new_bndr rhs' } -------------------------- -simplNonRecX :: SimplEnv +simplAuxBind :: SimplEnv -> InId -- Old binder; not a JoinId -> OutExpr -- Simplified RHS -> SimplM (SimplFloats, SimplEnv) --- A specialised variant of simplNonRec used when the RHS is already --- simplified, notably in knownCon. It uses case-binding where necessary. +-- A specialised variant of completeBindX used to construct non-recursive +-- auxiliary bindings, notably in knownCon. +-- +-- The binder comes from a case expression (case binder or alternative) +-- and so does not have rules, inline pragmas etc. -- -- Precondition: rhs satisfies the let-can-float invariant -simplNonRecX env bndr new_rhs - | assertPpr (not (isJoinId bndr)) (ppr bndr) $ +simplAuxBind env bndr new_rhs + | assertPpr (isId bndr && not (isJoinId bndr)) (ppr bndr) $ isDeadBinder bndr -- Not uncommon; e.g. case (a,b) of c { (p,q) -> p } = return (emptyFloats env, env) -- Here c is dead, and we avoid - -- creating the binding c = (a,b) - - | Coercion co <- new_rhs - = return (emptyFloats env, extendCvSubst env bndr co) + -- creating the binding c = (a,b) + -- The cases would be inlined unconditionally by completeBind: + -- but it seems not uncommon, and avoids faff to do it here + -- This is safe because it's only used for auxiliary bindings, which + -- have no NOLINE pragmas, nor RULEs | exprIsTrivial new_rhs -- Short-cut for let x = y in ... - -- This case would ultimately land in postInlineUnconditionally - -- but it seems not uncommon, and avoids a lot of faff to do it here - = return (emptyFloats env - , extendIdSubst env bndr (DoneEx new_rhs Nothing)) + = return ( emptyFloats env + , case new_rhs of + Coercion co -> extendCvSubst env bndr co + _ -> extendIdSubst env bndr (DoneEx new_rhs Nothing) ) | otherwise - = do { (env1, new_bndr) <- simplBinder env bndr - ; let is_strict = isStrictId new_bndr - -- isStrictId: use new_bndr because the InId bndr might not have - -- a fixed runtime representation, which isStrictId doesn't expect - -- c.f. Note [Dark corner with representation polymorphism] - - ; (rhs_floats, rhs1) <- prepareBinding env NotTopLevel NonRecursive is_strict - new_bndr (emptyFloats env) new_rhs - -- NB: it makes a surprisingly big difference (5% in compiler allocation - -- in T9630) to pass 'env' rather than 'env1'. It's fine to pass 'env', - -- because this is simplNonRecX, so bndr is not in scope in the RHS. - - ; (bind_float, env2) <- completeBind (env1 `setInScopeFromF` rhs_floats) - (BC_Let NotTopLevel NonRecursive) + = do { -- ANF-ise the RHS + let !occ_fs = getOccFS bndr + ; (anf_floats, rhs1) <- prepareRhs env NotTopLevel occ_fs new_rhs + ; unless (isEmptyLetFloats anf_floats) (tick LetFloatFromLet) + ; let rhs_floats = emptyFloats env `addLetFloats` anf_floats + + -- Simplify the binder and complete the binding + ; (env1, new_bndr) <- simplBinder (env `setInScopeFromF` rhs_floats) bndr + ; (bind_float, env2) <- completeBind env1 (BC_Let NotTopLevel NonRecursive) bndr new_bndr rhs1 - -- Must pass env1 to completeBind in case simplBinder had to clone, - -- and extended the substitution with [bndr :-> new_bndr] ; return (rhs_floats `addFloats` bind_float, env2) } @@ -761,49 +758,54 @@ prepareRhs :: HasDebugCallStack -- x = Just a -- See Note [prepareRhs] prepareRhs env top_lvl occ rhs0 - = do { (_is_exp, floats, rhs1) <- go 0 rhs0 - ; return (floats, rhs1) } + | is_expandable = anfise rhs0 + | otherwise = return (emptyLetFloats, rhs0) where - go :: Int -> OutExpr -> SimplM (Bool, LetFloats, OutExpr) - go n_val_args (Cast rhs co) - = do { (is_exp, floats, rhs') <- go n_val_args rhs - ; return (is_exp, floats, Cast rhs' co) } - go n_val_args (App fun (Type ty)) - = do { (is_exp, floats, rhs') <- go n_val_args fun - ; return (is_exp, floats, App rhs' (Type ty)) } - go n_val_args (App fun arg) - = do { (is_exp, floats1, fun') <- go (n_val_args+1) fun - ; if is_exp - then do { (floats2, arg') <- makeTrivial env top_lvl topDmd occ arg - ; return (True, floats1 `addLetFlts` floats2, App fun' arg') } - else return (False, emptyLetFloats, App fun arg) - } - go n_val_args (Var fun) - = return (is_exp, emptyLetFloats, Var fun) - where - is_exp = isExpandableApp fun n_val_args -- The fun a constructor or PAP - -- See Note [CONLIKE pragma] in GHC.Types.Basic - -- The definition of is_exp should match that in - -- 'GHC.Core.Opt.OccurAnal.occAnalApp' - - go n_val_args (Tick t rhs) + -- We can' use exprIsExpandable because the WHOLE POINT is that + -- we want to treat (K ) as expandable, because we are just + -- about "anfise" the expression. exprIsExpandable would + -- just say no! + is_expandable = go rhs0 0 + where + go (Var fun) n_val_args = isExpandableApp fun n_val_args + go (App fun arg) n_val_args + | isTypeArg arg = go fun n_val_args + | otherwise = go fun (n_val_args + 1) + go (Cast rhs _) n_val_args = go rhs n_val_args + go (Tick _ rhs) n_val_args = go rhs n_val_args + go _ _ = False + + anfise :: OutExpr -> SimplM (LetFloats, OutExpr) + anfise (Cast rhs co) + = do { (floats, rhs') <- anfise rhs + ; return (floats, Cast rhs' co) } + anfise (App fun (Type ty)) + = do { (floats, rhs') <- anfise fun + ; return (floats, App rhs' (Type ty)) } + anfise (App fun arg) + = do { (floats1, fun') <- anfise fun + ; (floats2, arg') <- makeTrivial env top_lvl topDmd occ arg + ; return (floats1 `addLetFlts` floats2, App fun' arg') } + anfise (Var fun) + = return (emptyLetFloats, Var fun) + + anfise (Tick t rhs) -- We want to be able to float bindings past this -- tick. Non-scoping ticks don't care. | tickishScoped t == NoScope - = do { (is_exp, floats, rhs') <- go n_val_args rhs - ; return (is_exp, floats, Tick t rhs') } + = do { (floats, rhs') <- anfise rhs + ; return (floats, Tick t rhs') } -- On the other hand, for scoping ticks we need to be able to -- copy them on the floats, which in turn is only allowed if -- we can obtain non-counting ticks. | (not (tickishCounts t) || tickishCanSplit t) - = do { (is_exp, floats, rhs') <- go n_val_args rhs + = do { (floats, rhs') <- anfise rhs ; let tickIt (id, expr) = (id, mkTick (mkNoCount t) expr) floats' = mapLetFloats floats tickIt - ; return (is_exp, floats', Tick t rhs') } + ; return (floats', Tick t rhs') } - go _ other - = return (False, emptyLetFloats, other) + anfise other = return (emptyLetFloats, other) makeTrivialArg :: HasDebugCallStack => SimplEnv -> ArgSpec -> SimplM (LetFloats, ArgSpec) makeTrivialArg env arg@(ValArg { as_arg = e, as_dmd = dmd }) @@ -1244,7 +1246,7 @@ simplExprF1 env (Let (NonRec bndr rhs) body) cont | otherwise = {-#SCC "simplNonRecE" #-} - simplNonRecE env False bndr (rhs, env) body cont + simplNonRecE env FromLet bndr (rhs, env) body cont {- Note [Avoiding space leaks in OutType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1505,8 +1507,9 @@ rebuild env expr cont StrictArg { sc_fun = fun, sc_cont = cont, sc_fun_ty = fun_ty } -> rebuildCall env (addValArgTo fun expr fun_ty ) cont - StrictBind { sc_bndr = b, sc_body = body, sc_env = se, sc_cont = cont } - -> completeBindX (se `setInScopeFromE` env) b expr body cont + StrictBind { sc_bndr = b, sc_body = body, sc_env = se + , sc_cont = cont, sc_from = from_what } + -> completeBindX (se `setInScopeFromE` env) from_what b expr body cont ApplyToTy { sc_arg_ty = ty, sc_cont = cont} -> rebuild env (App expr (Type ty)) cont @@ -1518,25 +1521,48 @@ rebuild env expr cont ; rebuild env (App expr arg') cont } completeBindX :: SimplEnv + -> FromWhat -> InId -> OutExpr -- Bind this Id to this (simplified) expression -- (the let-can-float invariant may not be satisfied) - -> InExpr -- In this lambda + -> InExpr -- In this body -> SimplCont -- Consumed by this continuation -> SimplM (SimplFloats, OutExpr) -completeBindX env bndr rhs body cont - | needsCaseBinding (idType bndr) rhs -- Enforcing the let-can-float-invariant - = do { (env1, bndr1) <- simplNonRecBndr env bndr - ; (floats, expr') <- simplLam env1 body cont +completeBindX env from_what bndr rhs body cont + | FromBeta arg_ty <- from_what + , needsCaseBinding arg_ty rhs -- Enforcing the let-can-float-invariant + = do { (env1, bndr1) <- simplNonRecBndr env bndr -- Lambda binders don't have rules + ; (floats, expr') <- simplNonRecBody env1 from_what body cont -- Do not float floats past the Case binder below ; let expr'' = wrapFloats floats expr' - ; let case_expr = Case rhs bndr1 (contResultType cont) [Alt DEFAULT [] expr''] + case_expr = Case rhs bndr1 (contResultType cont) [Alt DEFAULT [] expr''] ; return (emptyFloats env, case_expr) } - | otherwise - = do { (floats1, env') <- simplNonRecX env bndr rhs - ; (floats2, expr') <- simplLam env' body cont - ; return (floats1 `addFloats` floats2, expr') } + | otherwise -- Make a let-binding + = do { (env1, bndr1) <- simplNonRecBndr env bndr + ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) + + ; let is_strict = isStrictId bndr2 + -- isStrictId: use simplified binder because the InId bndr might not have + -- a fixed runtime representation, which isStrictId doesn't expect + -- c.f. Note [Dark corner with representation polymorphism] + + ; (rhs_floats, rhs1) <- prepareBinding env NotTopLevel NonRecursive is_strict + bndr2 (emptyFloats env) rhs + -- NB: it makes a surprisingly big difference (5% in compiler allocation + -- in T9630) to pass 'env' rather than 'env1'. It's fine to pass 'env', + -- because this is simplNonRecX, so bndr is not in scope in the RHS. + + ; (bind_float, env2) <- completeBind (env2 `setInScopeFromF` rhs_floats) + (BC_Let NotTopLevel NonRecursive) + bndr bndr2 rhs1 + -- Must pass env1 to completeBind in case simplBinder had to clone, + -- and extended the substitution with [bndr :-> new_bndr] + + -- Simplify the body + ; (body_floats, body') <- simplNonRecBody env2 from_what body cont + ; let all_floats = rhs_floats `addFloats` bind_float `addFloats` body_floats + ; return ( all_floats, body' ) } {- ************************************************************************ @@ -1674,6 +1700,14 @@ simplArg env dup_flag fun_ty arg_env arg ************************************************************************ -} +simplNonRecBody :: SimplEnv -> FromWhat + -> InExpr -> SimplCont + -> SimplM (SimplFloats, OutExpr) +simplNonRecBody env from_what body cont + = case from_what of + FromLet -> simplExprF env body cont + FromBeta {} -> simplLam env body cont + simplLam :: SimplEnv -> InExpr -> SimplCont -> SimplM (SimplFloats, OutExpr) @@ -1690,15 +1724,24 @@ simpl_lam env bndr body (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = cont }) -- Value beta-reduction simpl_lam env bndr body (ApplyToVal { sc_arg = arg, sc_env = arg_se - , sc_cont = cont, sc_dup = dup }) - | isSimplified dup -- Don't re-simplify if we've simplified it once - -- See Note [Avoiding exponential behaviour] + , sc_cont = cont, sc_dup = dup + , sc_hole_ty = fun_ty}) = do { tick (BetaReduction bndr) - ; completeBindX env bndr arg body cont } + ; let arg_ty = funArgTy fun_ty + ; if | isSimplified dup -- Don't re-simplify if we've simplified it once + -- Including don't preInlineUnconditionally + -- See Note [Avoiding exponential behaviour] + -> completeBindX env (FromBeta arg_ty) bndr arg body cont + + | Just env' <- preInlineUnconditionally env NotTopLevel bndr arg arg_se + , not (needsCaseBinding arg_ty arg) + -- Ok to test arg::InExpr in needsCaseBinding because + -- exprOkForSpeculation is stable under simplification + -> do { tick (PreInlineUnconditionally bndr) + ; simplLam env' body cont } - | otherwise -- See Note [Avoiding exponential behaviour] - = do { tick (BetaReduction bndr) - ; simplNonRecE env True bndr (arg, arg_se) body cont } + | otherwise + -> simplNonRecE env (FromBeta arg_ty) bndr (arg, arg_se) body cont } -- Discard a non-counting tick on a lambda. This may change the -- cost attribution slightly (moving the allocation of the @@ -1730,8 +1773,7 @@ simplLamBndrs env bndrs = mapAccumLM simplLamBndr env bndrs ------------------ simplNonRecE :: SimplEnv - -> Bool -- True <=> from a lambda - -- False <=> from a let + -> FromWhat -> InId -- The binder, always an Id -- Never a join point -> (InExpr, SimplEnv) -- Rhs of binding (or arg of lambda) @@ -1740,56 +1782,48 @@ simplNonRecE :: SimplEnv -> SimplM (SimplFloats, OutExpr) -- simplNonRecE is used for --- * non-top-level non-recursive non-join-point lets in expressions --- * beta reduction +-- * from=FromLet: a non-top-level non-recursive non-join-point let-expression +-- * from=FromBeta: a binding arising from a beta reduction -- --- simplNonRec env b (rhs, rhs_se) body k +-- simplNonRecE env b (rhs, rhs_se) body k -- = let env in -- cont< let b = rhs_se(rhs) in body > -- -- It deals with strict bindings, via the StrictBind continuation, -- which may abort the whole process. -- --- from_lam=False => the RHS satisfies the let-can-float invariant +-- from_what=FromLet => the RHS satisfies the let-can-float invariant -- Otherwise it may or may not satisfy it. -simplNonRecE env from_lam bndr (rhs, rhs_se) body cont - = assert (isId bndr && not (isJoinId bndr) ) $ - do { (env1, bndr1) <- simplNonRecBndr env bndr - ; let needs_case_binding = needsCaseBinding (idType bndr1) rhs - -- See Note [Dark corner with representation polymorphism] - -- If from_lam=False then needs_case_binding is False, - -- because the binding started as a let, which must - -- satisfy let-can-float - - ; if | from_lam && not needs_case_binding - -- If not from_lam we are coming from a (NonRec bndr rhs) binding - -- and preInlineUnconditionally has been done already; - -- no need to repeat it. But for lambdas we must be careful about - -- preInlineUndonditionally: consider (\(x:Int#). 3) (error "urk") - -- We must not drop the (error "urk"). - , Just env' <- preInlineUnconditionally env NotTopLevel bndr rhs rhs_se - -> do { tick (PreInlineUnconditionally bndr) - ; -- pprTrace "preInlineUncond" (ppr bndr <+> ppr rhs) $ - simplLam env' body cont } - - -- Deal with strict bindings - | isStrictId bndr1 && seCaseCase env - || from_lam && needs_case_binding - -- The important bit here is needs_case_binds; but no need to - -- test it if from_lam is False because then needs_case_binding is False too - -- NB: either way, the RHS may or may not satisfy let-can-float - -- but that's ok for StrictBind. - -> simplExprF (rhs_se `setInScopeFromE` env) rhs - (StrictBind { sc_bndr = bndr, sc_body = body - , sc_env = env, sc_cont = cont, sc_dup = NoDup }) - - -- Deal with lazy bindings - | otherwise - -> do { (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) - ; (floats1, env3) <- simplLazyBind env2 NotTopLevel NonRecursive bndr bndr2 rhs rhs_se - ; (floats2, expr') <- simplLam env3 body cont - ; return (floats1 `addFloats` floats2, expr') } } +simplNonRecE env from_what bndr (rhs, rhs_se) body cont + | assert (isId bndr && not (isJoinId bndr) ) $ + is_strict_bind + = -- Evaluate RHS strictly + simplExprF (rhs_se `setInScopeFromE` env) rhs + (StrictBind { sc_bndr = bndr, sc_body = body, sc_from = from_what + , sc_env = env, sc_cont = cont, sc_dup = NoDup }) + + | otherwise -- Evaluate RHS lazily + = do { (env1, bndr1) <- simplNonRecBndr env bndr + ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) + ; (floats1, env3) <- simplLazyBind env2 NotTopLevel NonRecursive + bndr bndr2 rhs rhs_se + ; (floats2, expr') <- simplNonRecBody env3 from_what body cont + ; return (floats1 `addFloats` floats2, expr') } + + where + is_strict_bind = case from_what of + FromBeta arg_ty | isUnliftedType arg_ty -> True + -- If we are coming from a beta-reduction (FromBeta) we must + -- establish the let-can-float invariant, so go via StrictBind + -- If not, the invariant holds already, and it's optional. + -- Using arg_ty: see Note [Dark corner with representation polymorphism] + -- e.g (\r \(a::TYPE r) \(x::a). blah) @LiftedRep @Int arg + -- When we come to `x=arg` we myst choose lazy/strict correctly + -- It's wrong to err in either directly + + _ -> seCaseCase env && isStrUsedDmd (idDemandInfo bndr) + ------------------ simplRecE :: SimplEnv @@ -1835,7 +1869,7 @@ Note [Avoiding exponential behaviour] One way in which we can get exponential behaviour is if we simplify a big expression, and then re-simplify it -- and then this happens in a deeply-nested way. So we must be jolly careful about re-simplifying -an expression. That is why simplNonRecX does not try +an expression (#13379). That is why simplNonRecX does not try preInlineUnconditionally (unlike simplNonRecE). Example: @@ -2618,15 +2652,10 @@ Is this inefficient? Not really: we are about to walk over the result of the rule firing to simplify it, so occurrence analysis is at most a constant factor. -Possible improvement: occ-anal the rules when putting them in the -database; and in the simplifier just occ-anal the OutExpr arguments. -But that's more complicated and the rule RHS is usually tiny; so I'm -just doing the simple thing. - -Historical note: previously we did occ-anal the rules in Rule.hs, -but failed to occ-anal the OutExpr arguments, which led to the -nasty performance problem described above. - +Note, however, that the rule RHS is /already/ occ-analysed; see +Note [OccInfo in unfoldings and rules] in GHC.Core. There is something +unsatisfactory about doing it twice; but the rule RHS is usually very +small, and this is simple. Note [Optimising tagToEnum#] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2930,7 +2959,7 @@ rebuildCase env scrut case_bndr alts cont where simple_rhs env wfloats case_bndr_rhs bs rhs = assert (null bs) $ - do { (floats1, env') <- simplNonRecX env case_bndr case_bndr_rhs + do { (floats1, env') <- simplAuxBind env case_bndr case_bndr_rhs -- scrut is a constructor application, -- hence satisfies let-can-float invariant ; (floats2, expr') <- simplExprF env' rhs cont @@ -2997,7 +3026,7 @@ rebuildCase env scrut case_bndr alts@[Alt _ bndrs rhs] cont | all_dead_bndrs , doCaseToLet scrut case_bndr = do { tick (CaseElim case_bndr) - ; (floats1, env') <- simplNonRecX env case_bndr scrut + ; (floats1, env') <- simplAuxBind env case_bndr scrut ; (floats2, expr') <- simplExprF env' rhs cont ; return (floats1 `addFloats` floats2, expr') } @@ -3483,12 +3512,11 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont bind_args env' (b:bs') (arg : args) = assert (isId b) $ do { let b' = zap_occ b - -- Note that the binder might be "dead", because it doesn't - -- occur in the RHS; and simplNonRecX may therefore discard - -- it via postInlineUnconditionally. + -- zap_occ: the binder might be "dead", because it doesn't + -- occur in the RHS; and simplAuxBind may therefore discard it. -- Nevertheless we must keep it if the case-binder is alive, -- because it may be used in the con_app. See Note [knownCon occ info] - ; (floats1, env2) <- simplNonRecX env' b' arg -- arg satisfies let-can-float invariant + ; (floats1, env2) <- simplAuxBind env' b' arg -- arg satisfies let-can-float invariant ; (floats2, env3) <- bind_args env2 bs' args ; return (floats1 `addFloats` floats2, env3) } @@ -3514,7 +3542,7 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont ; let con_app = Var (dataConWorkId dc) `mkTyApps` dc_ty_args `mkApps` dc_args - ; simplNonRecX env bndr con_app } + ; simplAuxBind env bndr con_app } ------------------- missingAlt :: SimplEnv -> Id -> [InAlt] -> SimplCont @@ -3621,15 +3649,15 @@ mkDupableContWithDmds env dmds (TickIt t cont) ; return (floats, TickIt t cont') } mkDupableContWithDmds env _ - (StrictBind { sc_bndr = bndr, sc_body = body + (StrictBind { sc_bndr = bndr, sc_body = body, sc_from = from_what , sc_env = se, sc_cont = cont}) -- See Note [Duplicating StrictBind] -- K[ let x = <> in b ] --> join j x = K[ b ] -- j <> = do { let sb_env = se `setInScopeFromE` env ; (sb_env1, bndr') <- simplBinder sb_env bndr - ; (floats1, join_inner) <- simplLam sb_env1 body cont - -- No need to use mkDupableCont before simplLam; we + ; (floats1, join_inner) <- simplNonRecBody sb_env1 from_what body cont + -- No need to use mkDupableCont before simplNonRecBody; we -- use cont once here, and then share the result if necessary ; let join_body = wrapFloats floats1 join_inner @@ -3757,6 +3785,7 @@ mkDupableStrictBind env arg_bndr join_rhs res_ty , StrictBind { sc_bndr = arg_bndr , sc_body = join_rhs , sc_env = zapSubstEnv env + , sc_from = FromLet -- See Note [StaticEnv invariant] in GHC.Core.Opt.Simplify.Utils , sc_dup = OkToDup , sc_cont = mkBoringStop res_ty } ) @@ -4430,7 +4459,9 @@ simplRules env mb_new_id rules bind_cxt ; return (rule { ru_bndrs = bndrs' , ru_fn = fn_name' , ru_args = args' - , ru_rhs = rhs' }) } + , ru_rhs = occurAnalyseExpr rhs' }) } + -- Remember to occ-analyse, to drop dead code. + -- See Note [OccInfo in unfoldings and rules] in GHC.Core {- Note [Simplifying the RHS of a RULE] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -21,7 +21,7 @@ module GHC.Core.Opt.Simplify.Utils ( BindContext(..), bindContextLevel, -- The continuation type - SimplCont(..), DupFlag(..), StaticEnv, + SimplCont(..), DupFlag(..), FromWhat(..), StaticEnv, isSimplified, contIsStop, contIsDupable, contResultType, contHoleType, contHoleScaling, contIsTrivial, contArgs, contIsRhs, @@ -192,6 +192,7 @@ data SimplCont -- or, equivalently, = K[ (\x.b) e ] { sc_dup :: DupFlag -- See Note [DupFlag invariants] , sc_bndr :: InId + , sc_from :: FromWhat , sc_body :: InExpr , sc_env :: StaticEnv -- See Note [StaticEnv invariant] , sc_cont :: SimplCont } @@ -213,6 +214,8 @@ data SimplCont type StaticEnv = SimplEnv -- Just the static part is relevant +data FromWhat = FromLet | FromBeta OutType + -- See Note [DupFlag invariants] data DupFlag = NoDup -- Unsimplified, might be big | Simplified -- Simplified ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -63,6 +63,7 @@ import GHC.Core.Tidy ( tidyRules ) import GHC.Core.Map.Expr ( eqCoreExpr ) import GHC.Core.Opt.Arity( etaExpandToJoinPointRule ) import GHC.Core.Make ( mkCoreLams ) +import GHC.Core.Opt.OccurAnal( occurAnalyseExpr ) import GHC.Tc.Utils.TcType ( tcSplitTyConApp_maybe ) import GHC.Builtin.Types ( anyTypeOfKind ) @@ -189,13 +190,18 @@ mkRule :: Module -> Bool -> Bool -> RuleName -> Activation -- ^ Used to make 'CoreRule' for an 'Id' defined in the module being -- compiled. See also 'GHC.Core.CoreRule' mkRule this_mod is_auto is_local name act fn bndrs args rhs - = Rule { ru_name = name, ru_fn = fn, ru_act = act, - ru_bndrs = bndrs, ru_args = args, - ru_rhs = rhs, - ru_rough = roughTopNames args, - ru_origin = this_mod, - ru_orphan = orph, - ru_auto = is_auto, ru_local = is_local } + = Rule { ru_name = name + , ru_act = act + , ru_fn = fn + , ru_bndrs = bndrs + , ru_args = args + , ru_rhs = occurAnalyseExpr rhs + -- See Note [OccInfo in unfoldings and rules] + , ru_rough = roughTopNames args + , ru_origin = this_mod + , ru_orphan = orph + , ru_auto = is_auto + , ru_local = is_local } where -- Compute orphanhood. See Note [Orphans] in GHC.Core.InstEnv -- A rule is an orphan only if none of the variables ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -513,8 +513,8 @@ bindNonRec bndr rhs body -- | Tests whether we have to use a @case@ rather than @let@ binding for this -- expression as per the invariants of 'CoreExpr': see "GHC.Core#let_can_float_invariant" needsCaseBinding :: Type -> CoreExpr -> Bool -needsCaseBinding ty rhs = - mightBeUnliftedType ty && not (exprOkForSpeculation rhs) +needsCaseBinding ty rhs + = mightBeUnliftedType ty && not (exprOkForSpeculation rhs) -- Make a case expression instead of a let -- These can arise either from the desugarer, -- or from beta reductions: (\x.e) (x +# y) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4939,6 +4939,7 @@ needSourceNotes dflags = debugLevel dflags > 0 -- LinkerInfo contains any extra options needed by the system linker. data LinkerInfo = GnuLD [Option] + | Mold [Option] | GnuGold [Option] | LlvmLLD [Option] | DarwinLD [Option] ===================================== compiler/GHC/SysTools/Info.hs ===================================== @@ -70,6 +70,7 @@ The flag is only needed on ELF systems. On Windows (PE) and Mac OS X neededLinkArgs :: LinkerInfo -> [Option] neededLinkArgs (GnuLD o) = o +neededLinkArgs (Mold o) = o neededLinkArgs (GnuGold o) = o neededLinkArgs (LlvmLLD o) = o neededLinkArgs (DarwinLD o) = o @@ -106,6 +107,10 @@ getLinkerInfo' logger dflags = do -- see Note [ELF needed shared libs] "-Wl,--no-as-needed"]) + | any ("mold" `isPrefixOf`) stdo = + return (Mold $ map Option [ --see Note [ELF needed shared libs] + "-Wl,--no-as-needed"]) + | any ("GNU gold" `isPrefixOf`) stdo = -- GNU gold only needs --no-as-needed. #10110. -- ELF specific flag, see Note [ELF needed shared libs] ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -723,12 +723,14 @@ setIdCprSig id sig = modifyIdInfo (\info -> setCprSigInfo info sig) id zapIdDmdSig :: Id -> Id zapIdDmdSig id = modifyIdInfo (`setDmdSigInfo` nopSig) id --- | This predicate says whether the 'Id' has a strict demand placed on it or --- has a type such that it can always be evaluated strictly (i.e an --- unlifted type, as of GHC 7.6). We need to --- check separately whether the 'Id' has a so-called \"strict type\" because if --- the demand for the given @id@ hasn't been computed yet but @id@ has a strict --- type, we still want @isStrictId id@ to be @True at . +-- | `isStrictId` says whether either +-- (a) the 'Id' has a strict demand placed on it or +-- (b) definitely has a \"strict type\", such that it can always be +-- evaluated strictly (i.e an unlifted type) +-- We need to check (b) as well as (a), because when the demand for the +-- given `id` hasn't been computed yet but `id` has a strict +-- type, we still want `isStrictId id` to be `True`. +-- Returns False if the type is levity polymorphic; False is always safe. isStrictId :: Id -> Bool isStrictId id | assertPpr (isId id) (text "isStrictId: not an id: " <+> ppr id) $ ===================================== libraries/base/Data/OldList.hs ===================================== @@ -1511,7 +1511,7 @@ sortOn :: Ord b => (a -> b) -> [a] -> [a] sortOn f = map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x)) --- | Produce singleton list. +-- | Construct a list from a single element. -- -- >>> singleton True -- [True] ===================================== testsuite/tests/simplCore/should_compile/T22761.hs ===================================== @@ -0,0 +1,40 @@ +module T22761 where + +import T22761a + +newtype Mod m = Mod m deriving Num + +gcdExt :: Integer -> (Integer, Integer) +gcdExt x = go 0 x + where + go !_ 0 = (1, 1) + go r _ = go r r + +pow :: (Num m) => Mod m -> Mod m +pow x = x*x*x +{-# NOINLINE [1] pow #-} +{-# RULES +"powMod/3/Int" forall x. pow x = x*x*x +#-} + + +-- GHC puts `boo1` after `wom1` (since they don't appear connected) +-- Then { wom1 = foo True } rewrites to { wom1 = boo False } +-- so we need to do glomming. And that triggers the bug +-- in the RULE for `pow`! +-- +-- wom2/boo2 are there to still elicit the bug if +-- GHC reverses its default ordering + +{-# RULES +"wombat1" foo True = boo1 False +#-} + +wom1 = foo True +boo1 x = x + +{-# RULES +"wombat2" foo True = boo2 False +#-} +boo2 x = x +wom2 = foo True ===================================== testsuite/tests/simplCore/should_compile/T22761a.hs ===================================== @@ -0,0 +1,4 @@ +module T22761a where + +{-# NOINLINE [0] foo #-} +foo x = x ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -471,5 +471,6 @@ test('T22611', [when(wordsize(32), skip), grep_errmsg(r'\$salterF') ], compile, test('T22715_2', normal, multimod_compile, ['T22715_2', '-v0 -O -fspecialise-aggressively']) test('T22802', normal, compile, ['-O']) test('T15205', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) +test('T22761', normal, multimod_compile, ['T22761', '-O2 -v0']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ba9142df0e0f07bafb113f5361614fd3b9babc6...cd4ba2d757affc84a1e49d4509af097e5761dd74 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ba9142df0e0f07bafb113f5361614fd3b9babc6...cd4ba2d757affc84a1e49d4509af097e5761dd74 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 10 05:01:25 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 10 Feb 2023 00:01:25 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Refactor the simplifier a bit to fix #22761 Message-ID: <63e5cfa515889_2b039a5276061424c@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ee284dc1 by Simon Peyton Jones at 2023-02-10T00:01:05-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - d4a099d2 by Rebecca Turner at 2023-02-10T00:01:07-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 14 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/Types/Id.hs - + testsuite/tests/simplCore/should_compile/T22761.hs - + testsuite/tests/simplCore/should_compile/T22761a.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -1300,16 +1300,19 @@ data Unfolding df_args :: [CoreExpr] -- Args of the data con: types, superclasses and methods, } -- in positional order - | CoreUnfolding { -- An unfolding for an Id with no pragma, - -- or perhaps a NOINLINE pragma - -- (For NOINLINE, the phase, if any, is in the - -- InlinePragInfo for this Id.) - uf_tmpl :: CoreExpr, -- Template; occurrence info is correct - uf_src :: UnfoldingSource, -- Where the unfolding came from - uf_is_top :: Bool, -- True <=> top level binding - uf_cache :: UnfoldingCache, -- Cache of flags computable from the expr - -- See Note [Tying the 'CoreUnfolding' knot] - uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template. + | CoreUnfolding { -- An unfolding for an Id with no pragma, + -- or perhaps a NOINLINE pragma + -- (For NOINLINE, the phase, if any, is in the + -- InlinePragInfo for this Id.) + uf_tmpl :: CoreExpr, -- The unfolding itself (aka "template") + -- Always occ-analysed; + -- See Note [OccInfo in unfoldings and rules] + + uf_src :: UnfoldingSource, -- Where the unfolding came from + uf_is_top :: Bool, -- True <=> top level binding + uf_cache :: UnfoldingCache, -- Cache of flags computable from the expr + -- See Note [Tying the 'CoreUnfolding' knot] + uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template. } -- ^ An unfolding with redundant cached information. Parameters: -- @@ -1637,14 +1640,37 @@ change was requested by Roman, but it seems to make sense. Note [OccInfo in unfoldings and rules] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In unfoldings and rules, we guarantee that the template is occ-analysed, -so that the occurrence info on the binders is correct. This is important, -because the Simplifier does not re-analyse the template when using it. If -the occurrence info is wrong - - We may get more simplifier iterations than necessary, because - once-occ info isn't there - - More seriously, we may get an infinite loop if there's a Rec - without a loop breaker marked +In unfoldings and rules, we guarantee that the template is occ-analysed, so +that the occurrence info on the binders is correct. That way, when the +Simplifier inlines an unfolding, it doesn't need to occ-analysis it first. +(The Simplifier is designed to simplify occ-analysed expressions.) + +Given this decision it's vital that we do *always* do it. + +* If we don't, we may get more simplifier iterations than necessary, + because once-occ info isn't there + +* More seriously, we may get an infinite loop if there's a Rec without a + loop breaker marked. + +* Or we may get code that mentions variables not in scope: #22761 + e.g. Suppose we have a stable unfolding : \y. let z = p+1 in 3 + Then the pre-simplifier occ-anal will occ-anal the unfolding + (redundantly perhaps, but we need its free vars); this will not report + the use of `p`; so p's binding will be discarded, and yet `p` is still + mentioned. + + Better to occ-anal the unfolding at birth, which will drop the + z-binding as dead code. (Remember, it's the occurrence analyser that + drops dead code.) + +* Another example is #8892: + \x -> letrec { f = ...g...; g* = f } in body + where g* is (for some strange reason) the loop breaker. If we don't + occ-anal it when reading it in, we won't mark g as a loop breaker, and we + may inline g entirely in body, dropping its binding, and leaving the + occurrence in f out of scope. This happened in #8892, where the unfolding + in question was a DFun unfolding. ************************************************************************ ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -3088,8 +3088,15 @@ etaExpandToJoinPointRule join_arity rule@(Rule { ru_bndrs = bndrs, ru_rhs = rhs | need_args < 0 = pprPanic "etaExpandToJoinPointRule" (ppr join_arity $$ ppr rule) | otherwise - = rule { ru_bndrs = bndrs ++ new_bndrs, ru_args = args ++ new_args - , ru_rhs = new_rhs } + = rule { ru_bndrs = bndrs ++ new_bndrs + , ru_args = args ++ new_args + , ru_rhs = new_rhs } + -- new_rhs really ought to be occ-analysed (see GHC.Core Note + -- [OccInfo in unfoldings and rules]), but it makes a module loop to + -- do so; it doesn't happen often; and it doesn't really matter if + -- the outer binders have bogus occurrence info; and new_rhs won't + -- have dead code if rhs didn't. + where need_args = join_arity - length args (new_bndrs, new_rhs) = etaBodyForJoinPoint need_args rhs ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -2165,6 +2165,17 @@ So we have a fast-path that keeps the old tree if the occ_bs_env is empty. This just saves a bit of allocation and reconstruction; not a big deal. +This fast path exposes a tricky cornder, though (#22761). Supose we have + Unfolding = \x. let y = foo in x+1 +which includes a dead binding for `y`. In occAnalUnfolding we occ-anal +the unfolding and produce /no/ occurrences of `foo` (since `y` is +dead). But if we discard the occ-analysed syntax tree (which we do on +our fast path), and use the old one, we still /have/ an occurrence of +`foo` -- and that can lead to out-of-scope variables (#22761). + +Solution: always keep occ-analysed trees in unfoldings and rules, so they +have no dead code. See Note [OccInfo in unfoldings and rules] in GHC.Core. + Note [Cascading inlines] ~~~~~~~~~~~~~~~~~~~~~~~~ By default we use an rhsCtxt for the RHS of a binding. This tells the ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -1065,7 +1065,7 @@ subst_id_bndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) -- See Note [Bangs in the Simplifier] !id1 = uniqAway in_scope old_id !id2 = substIdType env id1 - !id3 = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding + !id3 = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding -- and fragile OccInfo !new_id = adjust_type id3 ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -319,14 +319,14 @@ simplLazyBind :: SimplEnv -> TopLevelFlag -> RecFlag -> InId -> OutId -- Binder, both pre-and post simpl -- Not a JoinId - -- The OutId has IdInfo, except arity, unfolding + -- The OutId has IdInfo (notably RULES), + -- except arity, unfolding -- Ids only, no TyVars -> InExpr -> SimplEnv -- The RHS and its environment -> SimplM (SimplFloats, SimplEnv) -- Precondition: the OutId is already in the InScopeSet of the incoming 'env' -- Precondition: not a JoinId -- Precondition: rhs obeys the let-can-float invariant --- NOT used for JoinIds simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se = assert (isId bndr ) assertPpr (not (isJoinId bndr)) (ppr bndr) $ @@ -398,48 +398,45 @@ simplJoinBind env is_rec cont old_bndr new_bndr rhs rhs_se ; completeBind env (BC_Join is_rec cont) old_bndr new_bndr rhs' } -------------------------- -simplNonRecX :: SimplEnv +simplAuxBind :: SimplEnv -> InId -- Old binder; not a JoinId -> OutExpr -- Simplified RHS -> SimplM (SimplFloats, SimplEnv) --- A specialised variant of simplNonRec used when the RHS is already --- simplified, notably in knownCon. It uses case-binding where necessary. +-- A specialised variant of completeBindX used to construct non-recursive +-- auxiliary bindings, notably in knownCon. +-- +-- The binder comes from a case expression (case binder or alternative) +-- and so does not have rules, inline pragmas etc. -- -- Precondition: rhs satisfies the let-can-float invariant -simplNonRecX env bndr new_rhs - | assertPpr (not (isJoinId bndr)) (ppr bndr) $ +simplAuxBind env bndr new_rhs + | assertPpr (isId bndr && not (isJoinId bndr)) (ppr bndr) $ isDeadBinder bndr -- Not uncommon; e.g. case (a,b) of c { (p,q) -> p } = return (emptyFloats env, env) -- Here c is dead, and we avoid - -- creating the binding c = (a,b) - - | Coercion co <- new_rhs - = return (emptyFloats env, extendCvSubst env bndr co) + -- creating the binding c = (a,b) + -- The cases would be inlined unconditionally by completeBind: + -- but it seems not uncommon, and avoids faff to do it here + -- This is safe because it's only used for auxiliary bindings, which + -- have no NOLINE pragmas, nor RULEs | exprIsTrivial new_rhs -- Short-cut for let x = y in ... - -- This case would ultimately land in postInlineUnconditionally - -- but it seems not uncommon, and avoids a lot of faff to do it here - = return (emptyFloats env - , extendIdSubst env bndr (DoneEx new_rhs Nothing)) + = return ( emptyFloats env + , case new_rhs of + Coercion co -> extendCvSubst env bndr co + _ -> extendIdSubst env bndr (DoneEx new_rhs Nothing) ) | otherwise - = do { (env1, new_bndr) <- simplBinder env bndr - ; let is_strict = isStrictId new_bndr - -- isStrictId: use new_bndr because the InId bndr might not have - -- a fixed runtime representation, which isStrictId doesn't expect - -- c.f. Note [Dark corner with representation polymorphism] - - ; (rhs_floats, rhs1) <- prepareBinding env NotTopLevel NonRecursive is_strict - new_bndr (emptyFloats env) new_rhs - -- NB: it makes a surprisingly big difference (5% in compiler allocation - -- in T9630) to pass 'env' rather than 'env1'. It's fine to pass 'env', - -- because this is simplNonRecX, so bndr is not in scope in the RHS. - - ; (bind_float, env2) <- completeBind (env1 `setInScopeFromF` rhs_floats) - (BC_Let NotTopLevel NonRecursive) + = do { -- ANF-ise the RHS + let !occ_fs = getOccFS bndr + ; (anf_floats, rhs1) <- prepareRhs env NotTopLevel occ_fs new_rhs + ; unless (isEmptyLetFloats anf_floats) (tick LetFloatFromLet) + ; let rhs_floats = emptyFloats env `addLetFloats` anf_floats + + -- Simplify the binder and complete the binding + ; (env1, new_bndr) <- simplBinder (env `setInScopeFromF` rhs_floats) bndr + ; (bind_float, env2) <- completeBind env1 (BC_Let NotTopLevel NonRecursive) bndr new_bndr rhs1 - -- Must pass env1 to completeBind in case simplBinder had to clone, - -- and extended the substitution with [bndr :-> new_bndr] ; return (rhs_floats `addFloats` bind_float, env2) } @@ -761,49 +758,54 @@ prepareRhs :: HasDebugCallStack -- x = Just a -- See Note [prepareRhs] prepareRhs env top_lvl occ rhs0 - = do { (_is_exp, floats, rhs1) <- go 0 rhs0 - ; return (floats, rhs1) } + | is_expandable = anfise rhs0 + | otherwise = return (emptyLetFloats, rhs0) where - go :: Int -> OutExpr -> SimplM (Bool, LetFloats, OutExpr) - go n_val_args (Cast rhs co) - = do { (is_exp, floats, rhs') <- go n_val_args rhs - ; return (is_exp, floats, Cast rhs' co) } - go n_val_args (App fun (Type ty)) - = do { (is_exp, floats, rhs') <- go n_val_args fun - ; return (is_exp, floats, App rhs' (Type ty)) } - go n_val_args (App fun arg) - = do { (is_exp, floats1, fun') <- go (n_val_args+1) fun - ; if is_exp - then do { (floats2, arg') <- makeTrivial env top_lvl topDmd occ arg - ; return (True, floats1 `addLetFlts` floats2, App fun' arg') } - else return (False, emptyLetFloats, App fun arg) - } - go n_val_args (Var fun) - = return (is_exp, emptyLetFloats, Var fun) - where - is_exp = isExpandableApp fun n_val_args -- The fun a constructor or PAP - -- See Note [CONLIKE pragma] in GHC.Types.Basic - -- The definition of is_exp should match that in - -- 'GHC.Core.Opt.OccurAnal.occAnalApp' - - go n_val_args (Tick t rhs) + -- We can' use exprIsExpandable because the WHOLE POINT is that + -- we want to treat (K ) as expandable, because we are just + -- about "anfise" the expression. exprIsExpandable would + -- just say no! + is_expandable = go rhs0 0 + where + go (Var fun) n_val_args = isExpandableApp fun n_val_args + go (App fun arg) n_val_args + | isTypeArg arg = go fun n_val_args + | otherwise = go fun (n_val_args + 1) + go (Cast rhs _) n_val_args = go rhs n_val_args + go (Tick _ rhs) n_val_args = go rhs n_val_args + go _ _ = False + + anfise :: OutExpr -> SimplM (LetFloats, OutExpr) + anfise (Cast rhs co) + = do { (floats, rhs') <- anfise rhs + ; return (floats, Cast rhs' co) } + anfise (App fun (Type ty)) + = do { (floats, rhs') <- anfise fun + ; return (floats, App rhs' (Type ty)) } + anfise (App fun arg) + = do { (floats1, fun') <- anfise fun + ; (floats2, arg') <- makeTrivial env top_lvl topDmd occ arg + ; return (floats1 `addLetFlts` floats2, App fun' arg') } + anfise (Var fun) + = return (emptyLetFloats, Var fun) + + anfise (Tick t rhs) -- We want to be able to float bindings past this -- tick. Non-scoping ticks don't care. | tickishScoped t == NoScope - = do { (is_exp, floats, rhs') <- go n_val_args rhs - ; return (is_exp, floats, Tick t rhs') } + = do { (floats, rhs') <- anfise rhs + ; return (floats, Tick t rhs') } -- On the other hand, for scoping ticks we need to be able to -- copy them on the floats, which in turn is only allowed if -- we can obtain non-counting ticks. | (not (tickishCounts t) || tickishCanSplit t) - = do { (is_exp, floats, rhs') <- go n_val_args rhs + = do { (floats, rhs') <- anfise rhs ; let tickIt (id, expr) = (id, mkTick (mkNoCount t) expr) floats' = mapLetFloats floats tickIt - ; return (is_exp, floats', Tick t rhs') } + ; return (floats', Tick t rhs') } - go _ other - = return (False, emptyLetFloats, other) + anfise other = return (emptyLetFloats, other) makeTrivialArg :: HasDebugCallStack => SimplEnv -> ArgSpec -> SimplM (LetFloats, ArgSpec) makeTrivialArg env arg@(ValArg { as_arg = e, as_dmd = dmd }) @@ -1244,7 +1246,7 @@ simplExprF1 env (Let (NonRec bndr rhs) body) cont | otherwise = {-#SCC "simplNonRecE" #-} - simplNonRecE env False bndr (rhs, env) body cont + simplNonRecE env FromLet bndr (rhs, env) body cont {- Note [Avoiding space leaks in OutType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1505,8 +1507,9 @@ rebuild env expr cont StrictArg { sc_fun = fun, sc_cont = cont, sc_fun_ty = fun_ty } -> rebuildCall env (addValArgTo fun expr fun_ty ) cont - StrictBind { sc_bndr = b, sc_body = body, sc_env = se, sc_cont = cont } - -> completeBindX (se `setInScopeFromE` env) b expr body cont + StrictBind { sc_bndr = b, sc_body = body, sc_env = se + , sc_cont = cont, sc_from = from_what } + -> completeBindX (se `setInScopeFromE` env) from_what b expr body cont ApplyToTy { sc_arg_ty = ty, sc_cont = cont} -> rebuild env (App expr (Type ty)) cont @@ -1518,25 +1521,48 @@ rebuild env expr cont ; rebuild env (App expr arg') cont } completeBindX :: SimplEnv + -> FromWhat -> InId -> OutExpr -- Bind this Id to this (simplified) expression -- (the let-can-float invariant may not be satisfied) - -> InExpr -- In this lambda + -> InExpr -- In this body -> SimplCont -- Consumed by this continuation -> SimplM (SimplFloats, OutExpr) -completeBindX env bndr rhs body cont - | needsCaseBinding (idType bndr) rhs -- Enforcing the let-can-float-invariant - = do { (env1, bndr1) <- simplNonRecBndr env bndr - ; (floats, expr') <- simplLam env1 body cont +completeBindX env from_what bndr rhs body cont + | FromBeta arg_ty <- from_what + , needsCaseBinding arg_ty rhs -- Enforcing the let-can-float-invariant + = do { (env1, bndr1) <- simplNonRecBndr env bndr -- Lambda binders don't have rules + ; (floats, expr') <- simplNonRecBody env1 from_what body cont -- Do not float floats past the Case binder below ; let expr'' = wrapFloats floats expr' - ; let case_expr = Case rhs bndr1 (contResultType cont) [Alt DEFAULT [] expr''] + case_expr = Case rhs bndr1 (contResultType cont) [Alt DEFAULT [] expr''] ; return (emptyFloats env, case_expr) } - | otherwise - = do { (floats1, env') <- simplNonRecX env bndr rhs - ; (floats2, expr') <- simplLam env' body cont - ; return (floats1 `addFloats` floats2, expr') } + | otherwise -- Make a let-binding + = do { (env1, bndr1) <- simplNonRecBndr env bndr + ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) + + ; let is_strict = isStrictId bndr2 + -- isStrictId: use simplified binder because the InId bndr might not have + -- a fixed runtime representation, which isStrictId doesn't expect + -- c.f. Note [Dark corner with representation polymorphism] + + ; (rhs_floats, rhs1) <- prepareBinding env NotTopLevel NonRecursive is_strict + bndr2 (emptyFloats env) rhs + -- NB: it makes a surprisingly big difference (5% in compiler allocation + -- in T9630) to pass 'env' rather than 'env1'. It's fine to pass 'env', + -- because this is simplNonRecX, so bndr is not in scope in the RHS. + + ; (bind_float, env2) <- completeBind (env2 `setInScopeFromF` rhs_floats) + (BC_Let NotTopLevel NonRecursive) + bndr bndr2 rhs1 + -- Must pass env1 to completeBind in case simplBinder had to clone, + -- and extended the substitution with [bndr :-> new_bndr] + + -- Simplify the body + ; (body_floats, body') <- simplNonRecBody env2 from_what body cont + ; let all_floats = rhs_floats `addFloats` bind_float `addFloats` body_floats + ; return ( all_floats, body' ) } {- ************************************************************************ @@ -1674,6 +1700,14 @@ simplArg env dup_flag fun_ty arg_env arg ************************************************************************ -} +simplNonRecBody :: SimplEnv -> FromWhat + -> InExpr -> SimplCont + -> SimplM (SimplFloats, OutExpr) +simplNonRecBody env from_what body cont + = case from_what of + FromLet -> simplExprF env body cont + FromBeta {} -> simplLam env body cont + simplLam :: SimplEnv -> InExpr -> SimplCont -> SimplM (SimplFloats, OutExpr) @@ -1690,15 +1724,24 @@ simpl_lam env bndr body (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = cont }) -- Value beta-reduction simpl_lam env bndr body (ApplyToVal { sc_arg = arg, sc_env = arg_se - , sc_cont = cont, sc_dup = dup }) - | isSimplified dup -- Don't re-simplify if we've simplified it once - -- See Note [Avoiding exponential behaviour] + , sc_cont = cont, sc_dup = dup + , sc_hole_ty = fun_ty}) = do { tick (BetaReduction bndr) - ; completeBindX env bndr arg body cont } + ; let arg_ty = funArgTy fun_ty + ; if | isSimplified dup -- Don't re-simplify if we've simplified it once + -- Including don't preInlineUnconditionally + -- See Note [Avoiding exponential behaviour] + -> completeBindX env (FromBeta arg_ty) bndr arg body cont + + | Just env' <- preInlineUnconditionally env NotTopLevel bndr arg arg_se + , not (needsCaseBinding arg_ty arg) + -- Ok to test arg::InExpr in needsCaseBinding because + -- exprOkForSpeculation is stable under simplification + -> do { tick (PreInlineUnconditionally bndr) + ; simplLam env' body cont } - | otherwise -- See Note [Avoiding exponential behaviour] - = do { tick (BetaReduction bndr) - ; simplNonRecE env True bndr (arg, arg_se) body cont } + | otherwise + -> simplNonRecE env (FromBeta arg_ty) bndr (arg, arg_se) body cont } -- Discard a non-counting tick on a lambda. This may change the -- cost attribution slightly (moving the allocation of the @@ -1730,8 +1773,7 @@ simplLamBndrs env bndrs = mapAccumLM simplLamBndr env bndrs ------------------ simplNonRecE :: SimplEnv - -> Bool -- True <=> from a lambda - -- False <=> from a let + -> FromWhat -> InId -- The binder, always an Id -- Never a join point -> (InExpr, SimplEnv) -- Rhs of binding (or arg of lambda) @@ -1740,56 +1782,48 @@ simplNonRecE :: SimplEnv -> SimplM (SimplFloats, OutExpr) -- simplNonRecE is used for --- * non-top-level non-recursive non-join-point lets in expressions --- * beta reduction +-- * from=FromLet: a non-top-level non-recursive non-join-point let-expression +-- * from=FromBeta: a binding arising from a beta reduction -- --- simplNonRec env b (rhs, rhs_se) body k +-- simplNonRecE env b (rhs, rhs_se) body k -- = let env in -- cont< let b = rhs_se(rhs) in body > -- -- It deals with strict bindings, via the StrictBind continuation, -- which may abort the whole process. -- --- from_lam=False => the RHS satisfies the let-can-float invariant +-- from_what=FromLet => the RHS satisfies the let-can-float invariant -- Otherwise it may or may not satisfy it. -simplNonRecE env from_lam bndr (rhs, rhs_se) body cont - = assert (isId bndr && not (isJoinId bndr) ) $ - do { (env1, bndr1) <- simplNonRecBndr env bndr - ; let needs_case_binding = needsCaseBinding (idType bndr1) rhs - -- See Note [Dark corner with representation polymorphism] - -- If from_lam=False then needs_case_binding is False, - -- because the binding started as a let, which must - -- satisfy let-can-float - - ; if | from_lam && not needs_case_binding - -- If not from_lam we are coming from a (NonRec bndr rhs) binding - -- and preInlineUnconditionally has been done already; - -- no need to repeat it. But for lambdas we must be careful about - -- preInlineUndonditionally: consider (\(x:Int#). 3) (error "urk") - -- We must not drop the (error "urk"). - , Just env' <- preInlineUnconditionally env NotTopLevel bndr rhs rhs_se - -> do { tick (PreInlineUnconditionally bndr) - ; -- pprTrace "preInlineUncond" (ppr bndr <+> ppr rhs) $ - simplLam env' body cont } - - -- Deal with strict bindings - | isStrictId bndr1 && seCaseCase env - || from_lam && needs_case_binding - -- The important bit here is needs_case_binds; but no need to - -- test it if from_lam is False because then needs_case_binding is False too - -- NB: either way, the RHS may or may not satisfy let-can-float - -- but that's ok for StrictBind. - -> simplExprF (rhs_se `setInScopeFromE` env) rhs - (StrictBind { sc_bndr = bndr, sc_body = body - , sc_env = env, sc_cont = cont, sc_dup = NoDup }) - - -- Deal with lazy bindings - | otherwise - -> do { (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) - ; (floats1, env3) <- simplLazyBind env2 NotTopLevel NonRecursive bndr bndr2 rhs rhs_se - ; (floats2, expr') <- simplLam env3 body cont - ; return (floats1 `addFloats` floats2, expr') } } +simplNonRecE env from_what bndr (rhs, rhs_se) body cont + | assert (isId bndr && not (isJoinId bndr) ) $ + is_strict_bind + = -- Evaluate RHS strictly + simplExprF (rhs_se `setInScopeFromE` env) rhs + (StrictBind { sc_bndr = bndr, sc_body = body, sc_from = from_what + , sc_env = env, sc_cont = cont, sc_dup = NoDup }) + + | otherwise -- Evaluate RHS lazily + = do { (env1, bndr1) <- simplNonRecBndr env bndr + ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) + ; (floats1, env3) <- simplLazyBind env2 NotTopLevel NonRecursive + bndr bndr2 rhs rhs_se + ; (floats2, expr') <- simplNonRecBody env3 from_what body cont + ; return (floats1 `addFloats` floats2, expr') } + + where + is_strict_bind = case from_what of + FromBeta arg_ty | isUnliftedType arg_ty -> True + -- If we are coming from a beta-reduction (FromBeta) we must + -- establish the let-can-float invariant, so go via StrictBind + -- If not, the invariant holds already, and it's optional. + -- Using arg_ty: see Note [Dark corner with representation polymorphism] + -- e.g (\r \(a::TYPE r) \(x::a). blah) @LiftedRep @Int arg + -- When we come to `x=arg` we myst choose lazy/strict correctly + -- It's wrong to err in either directly + + _ -> seCaseCase env && isStrUsedDmd (idDemandInfo bndr) + ------------------ simplRecE :: SimplEnv @@ -1835,7 +1869,7 @@ Note [Avoiding exponential behaviour] One way in which we can get exponential behaviour is if we simplify a big expression, and then re-simplify it -- and then this happens in a deeply-nested way. So we must be jolly careful about re-simplifying -an expression. That is why simplNonRecX does not try +an expression (#13379). That is why simplNonRecX does not try preInlineUnconditionally (unlike simplNonRecE). Example: @@ -2618,15 +2652,10 @@ Is this inefficient? Not really: we are about to walk over the result of the rule firing to simplify it, so occurrence analysis is at most a constant factor. -Possible improvement: occ-anal the rules when putting them in the -database; and in the simplifier just occ-anal the OutExpr arguments. -But that's more complicated and the rule RHS is usually tiny; so I'm -just doing the simple thing. - -Historical note: previously we did occ-anal the rules in Rule.hs, -but failed to occ-anal the OutExpr arguments, which led to the -nasty performance problem described above. - +Note, however, that the rule RHS is /already/ occ-analysed; see +Note [OccInfo in unfoldings and rules] in GHC.Core. There is something +unsatisfactory about doing it twice; but the rule RHS is usually very +small, and this is simple. Note [Optimising tagToEnum#] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2930,7 +2959,7 @@ rebuildCase env scrut case_bndr alts cont where simple_rhs env wfloats case_bndr_rhs bs rhs = assert (null bs) $ - do { (floats1, env') <- simplNonRecX env case_bndr case_bndr_rhs + do { (floats1, env') <- simplAuxBind env case_bndr case_bndr_rhs -- scrut is a constructor application, -- hence satisfies let-can-float invariant ; (floats2, expr') <- simplExprF env' rhs cont @@ -2997,7 +3026,7 @@ rebuildCase env scrut case_bndr alts@[Alt _ bndrs rhs] cont | all_dead_bndrs , doCaseToLet scrut case_bndr = do { tick (CaseElim case_bndr) - ; (floats1, env') <- simplNonRecX env case_bndr scrut + ; (floats1, env') <- simplAuxBind env case_bndr scrut ; (floats2, expr') <- simplExprF env' rhs cont ; return (floats1 `addFloats` floats2, expr') } @@ -3483,12 +3512,11 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont bind_args env' (b:bs') (arg : args) = assert (isId b) $ do { let b' = zap_occ b - -- Note that the binder might be "dead", because it doesn't - -- occur in the RHS; and simplNonRecX may therefore discard - -- it via postInlineUnconditionally. + -- zap_occ: the binder might be "dead", because it doesn't + -- occur in the RHS; and simplAuxBind may therefore discard it. -- Nevertheless we must keep it if the case-binder is alive, -- because it may be used in the con_app. See Note [knownCon occ info] - ; (floats1, env2) <- simplNonRecX env' b' arg -- arg satisfies let-can-float invariant + ; (floats1, env2) <- simplAuxBind env' b' arg -- arg satisfies let-can-float invariant ; (floats2, env3) <- bind_args env2 bs' args ; return (floats1 `addFloats` floats2, env3) } @@ -3514,7 +3542,7 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont ; let con_app = Var (dataConWorkId dc) `mkTyApps` dc_ty_args `mkApps` dc_args - ; simplNonRecX env bndr con_app } + ; simplAuxBind env bndr con_app } ------------------- missingAlt :: SimplEnv -> Id -> [InAlt] -> SimplCont @@ -3621,15 +3649,15 @@ mkDupableContWithDmds env dmds (TickIt t cont) ; return (floats, TickIt t cont') } mkDupableContWithDmds env _ - (StrictBind { sc_bndr = bndr, sc_body = body + (StrictBind { sc_bndr = bndr, sc_body = body, sc_from = from_what , sc_env = se, sc_cont = cont}) -- See Note [Duplicating StrictBind] -- K[ let x = <> in b ] --> join j x = K[ b ] -- j <> = do { let sb_env = se `setInScopeFromE` env ; (sb_env1, bndr') <- simplBinder sb_env bndr - ; (floats1, join_inner) <- simplLam sb_env1 body cont - -- No need to use mkDupableCont before simplLam; we + ; (floats1, join_inner) <- simplNonRecBody sb_env1 from_what body cont + -- No need to use mkDupableCont before simplNonRecBody; we -- use cont once here, and then share the result if necessary ; let join_body = wrapFloats floats1 join_inner @@ -3757,6 +3785,7 @@ mkDupableStrictBind env arg_bndr join_rhs res_ty , StrictBind { sc_bndr = arg_bndr , sc_body = join_rhs , sc_env = zapSubstEnv env + , sc_from = FromLet -- See Note [StaticEnv invariant] in GHC.Core.Opt.Simplify.Utils , sc_dup = OkToDup , sc_cont = mkBoringStop res_ty } ) @@ -4430,7 +4459,9 @@ simplRules env mb_new_id rules bind_cxt ; return (rule { ru_bndrs = bndrs' , ru_fn = fn_name' , ru_args = args' - , ru_rhs = rhs' }) } + , ru_rhs = occurAnalyseExpr rhs' }) } + -- Remember to occ-analyse, to drop dead code. + -- See Note [OccInfo in unfoldings and rules] in GHC.Core {- Note [Simplifying the RHS of a RULE] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -21,7 +21,7 @@ module GHC.Core.Opt.Simplify.Utils ( BindContext(..), bindContextLevel, -- The continuation type - SimplCont(..), DupFlag(..), StaticEnv, + SimplCont(..), DupFlag(..), FromWhat(..), StaticEnv, isSimplified, contIsStop, contIsDupable, contResultType, contHoleType, contHoleScaling, contIsTrivial, contArgs, contIsRhs, @@ -192,6 +192,7 @@ data SimplCont -- or, equivalently, = K[ (\x.b) e ] { sc_dup :: DupFlag -- See Note [DupFlag invariants] , sc_bndr :: InId + , sc_from :: FromWhat , sc_body :: InExpr , sc_env :: StaticEnv -- See Note [StaticEnv invariant] , sc_cont :: SimplCont } @@ -213,6 +214,8 @@ data SimplCont type StaticEnv = SimplEnv -- Just the static part is relevant +data FromWhat = FromLet | FromBeta OutType + -- See Note [DupFlag invariants] data DupFlag = NoDup -- Unsimplified, might be big | Simplified -- Simplified ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -63,6 +63,7 @@ import GHC.Core.Tidy ( tidyRules ) import GHC.Core.Map.Expr ( eqCoreExpr ) import GHC.Core.Opt.Arity( etaExpandToJoinPointRule ) import GHC.Core.Make ( mkCoreLams ) +import GHC.Core.Opt.OccurAnal( occurAnalyseExpr ) import GHC.Tc.Utils.TcType ( tcSplitTyConApp_maybe ) import GHC.Builtin.Types ( anyTypeOfKind ) @@ -189,13 +190,18 @@ mkRule :: Module -> Bool -> Bool -> RuleName -> Activation -- ^ Used to make 'CoreRule' for an 'Id' defined in the module being -- compiled. See also 'GHC.Core.CoreRule' mkRule this_mod is_auto is_local name act fn bndrs args rhs - = Rule { ru_name = name, ru_fn = fn, ru_act = act, - ru_bndrs = bndrs, ru_args = args, - ru_rhs = rhs, - ru_rough = roughTopNames args, - ru_origin = this_mod, - ru_orphan = orph, - ru_auto = is_auto, ru_local = is_local } + = Rule { ru_name = name + , ru_act = act + , ru_fn = fn + , ru_bndrs = bndrs + , ru_args = args + , ru_rhs = occurAnalyseExpr rhs + -- See Note [OccInfo in unfoldings and rules] + , ru_rough = roughTopNames args + , ru_origin = this_mod + , ru_orphan = orph + , ru_auto = is_auto + , ru_local = is_local } where -- Compute orphanhood. See Note [Orphans] in GHC.Core.InstEnv -- A rule is an orphan only if none of the variables ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -513,8 +513,8 @@ bindNonRec bndr rhs body -- | Tests whether we have to use a @case@ rather than @let@ binding for this -- expression as per the invariants of 'CoreExpr': see "GHC.Core#let_can_float_invariant" needsCaseBinding :: Type -> CoreExpr -> Bool -needsCaseBinding ty rhs = - mightBeUnliftedType ty && not (exprOkForSpeculation rhs) +needsCaseBinding ty rhs + = mightBeUnliftedType ty && not (exprOkForSpeculation rhs) -- Make a case expression instead of a let -- These can arise either from the desugarer, -- or from beta reductions: (\x.e) (x +# y) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4939,6 +4939,7 @@ needSourceNotes dflags = debugLevel dflags > 0 -- LinkerInfo contains any extra options needed by the system linker. data LinkerInfo = GnuLD [Option] + | Mold [Option] | GnuGold [Option] | LlvmLLD [Option] | DarwinLD [Option] ===================================== compiler/GHC/SysTools/Info.hs ===================================== @@ -70,6 +70,7 @@ The flag is only needed on ELF systems. On Windows (PE) and Mac OS X neededLinkArgs :: LinkerInfo -> [Option] neededLinkArgs (GnuLD o) = o +neededLinkArgs (Mold o) = o neededLinkArgs (GnuGold o) = o neededLinkArgs (LlvmLLD o) = o neededLinkArgs (DarwinLD o) = o @@ -106,6 +107,10 @@ getLinkerInfo' logger dflags = do -- see Note [ELF needed shared libs] "-Wl,--no-as-needed"]) + | any ("mold" `isPrefixOf`) stdo = + return (Mold $ map Option [ --see Note [ELF needed shared libs] + "-Wl,--no-as-needed"]) + | any ("GNU gold" `isPrefixOf`) stdo = -- GNU gold only needs --no-as-needed. #10110. -- ELF specific flag, see Note [ELF needed shared libs] ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -723,12 +723,14 @@ setIdCprSig id sig = modifyIdInfo (\info -> setCprSigInfo info sig) id zapIdDmdSig :: Id -> Id zapIdDmdSig id = modifyIdInfo (`setDmdSigInfo` nopSig) id --- | This predicate says whether the 'Id' has a strict demand placed on it or --- has a type such that it can always be evaluated strictly (i.e an --- unlifted type, as of GHC 7.6). We need to --- check separately whether the 'Id' has a so-called \"strict type\" because if --- the demand for the given @id@ hasn't been computed yet but @id@ has a strict --- type, we still want @isStrictId id@ to be @True at . +-- | `isStrictId` says whether either +-- (a) the 'Id' has a strict demand placed on it or +-- (b) definitely has a \"strict type\", such that it can always be +-- evaluated strictly (i.e an unlifted type) +-- We need to check (b) as well as (a), because when the demand for the +-- given `id` hasn't been computed yet but `id` has a strict +-- type, we still want `isStrictId id` to be `True`. +-- Returns False if the type is levity polymorphic; False is always safe. isStrictId :: Id -> Bool isStrictId id | assertPpr (isId id) (text "isStrictId: not an id: " <+> ppr id) $ ===================================== testsuite/tests/simplCore/should_compile/T22761.hs ===================================== @@ -0,0 +1,40 @@ +module T22761 where + +import T22761a + +newtype Mod m = Mod m deriving Num + +gcdExt :: Integer -> (Integer, Integer) +gcdExt x = go 0 x + where + go !_ 0 = (1, 1) + go r _ = go r r + +pow :: (Num m) => Mod m -> Mod m +pow x = x*x*x +{-# NOINLINE [1] pow #-} +{-# RULES +"powMod/3/Int" forall x. pow x = x*x*x +#-} + + +-- GHC puts `boo1` after `wom1` (since they don't appear connected) +-- Then { wom1 = foo True } rewrites to { wom1 = boo False } +-- so we need to do glomming. And that triggers the bug +-- in the RULE for `pow`! +-- +-- wom2/boo2 are there to still elicit the bug if +-- GHC reverses its default ordering + +{-# RULES +"wombat1" foo True = boo1 False +#-} + +wom1 = foo True +boo1 x = x + +{-# RULES +"wombat2" foo True = boo2 False +#-} +boo2 x = x +wom2 = foo True ===================================== testsuite/tests/simplCore/should_compile/T22761a.hs ===================================== @@ -0,0 +1,4 @@ +module T22761a where + +{-# NOINLINE [0] foo #-} +foo x = x ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -471,5 +471,6 @@ test('T22611', [when(wordsize(32), skip), grep_errmsg(r'\$salterF') ], compile, test('T22715_2', normal, multimod_compile, ['T22715_2', '-v0 -O -fspecialise-aggressively']) test('T22802', normal, compile, ['-O']) test('T15205', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) +test('T22761', normal, multimod_compile, ['T22761', '-O2 -v0']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cd4ba2d757affc84a1e49d4509af097e5761dd74...d4a099d28f3ba9f4df563083b3f2014d6d154a76 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cd4ba2d757affc84a1e49d4509af097e5761dd74...d4a099d28f3ba9f4df563083b3f2014d6d154a76 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 10 06:26:38 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 10 Feb 2023 01:26:38 -0500 Subject: [Git][ghc/ghc][wip/mp-backports-batch-2] testsuite: Drop inapplicable tests Message-ID: <63e5e39e266b7_2b039a5271062101e@gitlab.mail> Ben Gamari pushed to branch wip/mp-backports-batch-2 at Glasgow Haskell Compiler / GHC Commits: f63da175 by Ben Gamari at 2023-02-10T01:25:53-05:00 testsuite: Drop inapplicable tests These rely on TypeAbstractions, which is not implemented in 9.6.1. - - - - - 5 changed files: - − testsuite/tests/gadt/T19847a.hs - − testsuite/tests/gadt/T19847a.stderr - testsuite/tests/gadt/all.T - − testsuite/tests/typecheck/should_compile/T21501.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== testsuite/tests/gadt/T19847a.hs deleted ===================================== @@ -1,14 +0,0 @@ -{-# LANGUAGE LambdaCase, GADTs, ScopedTypeVariables, TypeAbstractions #-} - -module T19847a where - -data T a b c where - MkT :: forall c y x b. (x~y, c~[x], Ord x) => x -> y -> T (x,y) b c - -f :: forall b c. (T (Int,Int) b c -> Bool) -> (b,c) -f = error "urk" - -h = f (\case { MkT @_ @_ @_ @Int p q -> True }) --- Check that the @Int argument can affect --- the type at which `f` is instantiated --- So h :: forall c. (Int,c) ===================================== testsuite/tests/gadt/T19847a.stderr deleted ===================================== @@ -1,12 +0,0 @@ -TYPE SIGNATURES - f :: forall b c. (T (Int, Int) b c -> Bool) -> (b, c) - h :: forall {c}. (Int, c) -TYPE CONSTRUCTORS - data type T{4} :: forall {k}. * -> k -> * -> * - roles nominal nominal phantom nominal -DATA CONSTRUCTORS - MkT :: forall {k} c y x (b :: k). - (x ~ y, c ~ [x], Ord x) => - x -> y -> T (x, y) b c -Dependent modules: [] -Dependent packages: [base-4.18.0.0] ===================================== testsuite/tests/gadt/all.T ===================================== @@ -127,4 +127,3 @@ test('T20485', normal, compile, ['']) test('T20485a', normal, compile, ['']) test('T22235', normal, compile, ['']) test('T19847', normal, compile, ['']) -test('T19847a', normal, compile, ['-ddump-types']) ===================================== testsuite/tests/typecheck/should_compile/T21501.hs deleted ===================================== @@ -1,24 +0,0 @@ -{-# LANGUAGE MonoLocalBinds, PatternSynonyms, ViewPatterns, TypeAbstractions #-} - -module T21501 where - -import Data.Kind -import Type.Reflection - -pattern TypeApp :: - forall {k1} {k2} (f :: k1 -> k2) (result :: k2). - Typeable f => - forall (arg :: k1). - result ~ f arg => - TypeRep arg -> - TypeRep result -pattern TypeApp arg_rep <- App (eqTypeRep (typeRep @f) -> Just HRefl) arg_rep - -f :: TypeRep (a :: Type) -> String -f (TypeApp @[] rep) = show rep - -{- Expected type: TypeRep k (a::k) - Instantiate at k10 k20 (f0 :: k10 -> k20) (result0 :: k20) - Unify (TypeRep k (a::k) ~ TypeRep k20 (result :: k20) - Unify f0 ~ [] --} ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -858,4 +858,3 @@ test('T22516', normal, compile, ['']) test('T22647', normal, compile, ['']) test('T19577', normal, compile, ['']) test('T22383', normal, compile, ['']) -test('T21501', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f63da175da1f4196d9beab6571998fdd444835d4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f63da175da1f4196d9beab6571998fdd444835d4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 10 07:51:38 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 10 Feb 2023 02:51:38 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Refactor the simplifier a bit to fix #22761 Message-ID: <63e5f78a37c5_2b039a8fa7a0627152@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: eaf5554b by Simon Peyton Jones at 2023-02-10T02:51:20-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - f8370c8b by Rebecca Turner at 2023-02-10T02:51:23-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 14 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/Types/Id.hs - + testsuite/tests/simplCore/should_compile/T22761.hs - + testsuite/tests/simplCore/should_compile/T22761a.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -1300,16 +1300,19 @@ data Unfolding df_args :: [CoreExpr] -- Args of the data con: types, superclasses and methods, } -- in positional order - | CoreUnfolding { -- An unfolding for an Id with no pragma, - -- or perhaps a NOINLINE pragma - -- (For NOINLINE, the phase, if any, is in the - -- InlinePragInfo for this Id.) - uf_tmpl :: CoreExpr, -- Template; occurrence info is correct - uf_src :: UnfoldingSource, -- Where the unfolding came from - uf_is_top :: Bool, -- True <=> top level binding - uf_cache :: UnfoldingCache, -- Cache of flags computable from the expr - -- See Note [Tying the 'CoreUnfolding' knot] - uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template. + | CoreUnfolding { -- An unfolding for an Id with no pragma, + -- or perhaps a NOINLINE pragma + -- (For NOINLINE, the phase, if any, is in the + -- InlinePragInfo for this Id.) + uf_tmpl :: CoreExpr, -- The unfolding itself (aka "template") + -- Always occ-analysed; + -- See Note [OccInfo in unfoldings and rules] + + uf_src :: UnfoldingSource, -- Where the unfolding came from + uf_is_top :: Bool, -- True <=> top level binding + uf_cache :: UnfoldingCache, -- Cache of flags computable from the expr + -- See Note [Tying the 'CoreUnfolding' knot] + uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template. } -- ^ An unfolding with redundant cached information. Parameters: -- @@ -1637,14 +1640,37 @@ change was requested by Roman, but it seems to make sense. Note [OccInfo in unfoldings and rules] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In unfoldings and rules, we guarantee that the template is occ-analysed, -so that the occurrence info on the binders is correct. This is important, -because the Simplifier does not re-analyse the template when using it. If -the occurrence info is wrong - - We may get more simplifier iterations than necessary, because - once-occ info isn't there - - More seriously, we may get an infinite loop if there's a Rec - without a loop breaker marked +In unfoldings and rules, we guarantee that the template is occ-analysed, so +that the occurrence info on the binders is correct. That way, when the +Simplifier inlines an unfolding, it doesn't need to occ-analysis it first. +(The Simplifier is designed to simplify occ-analysed expressions.) + +Given this decision it's vital that we do *always* do it. + +* If we don't, we may get more simplifier iterations than necessary, + because once-occ info isn't there + +* More seriously, we may get an infinite loop if there's a Rec without a + loop breaker marked. + +* Or we may get code that mentions variables not in scope: #22761 + e.g. Suppose we have a stable unfolding : \y. let z = p+1 in 3 + Then the pre-simplifier occ-anal will occ-anal the unfolding + (redundantly perhaps, but we need its free vars); this will not report + the use of `p`; so p's binding will be discarded, and yet `p` is still + mentioned. + + Better to occ-anal the unfolding at birth, which will drop the + z-binding as dead code. (Remember, it's the occurrence analyser that + drops dead code.) + +* Another example is #8892: + \x -> letrec { f = ...g...; g* = f } in body + where g* is (for some strange reason) the loop breaker. If we don't + occ-anal it when reading it in, we won't mark g as a loop breaker, and we + may inline g entirely in body, dropping its binding, and leaving the + occurrence in f out of scope. This happened in #8892, where the unfolding + in question was a DFun unfolding. ************************************************************************ ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -3088,8 +3088,15 @@ etaExpandToJoinPointRule join_arity rule@(Rule { ru_bndrs = bndrs, ru_rhs = rhs | need_args < 0 = pprPanic "etaExpandToJoinPointRule" (ppr join_arity $$ ppr rule) | otherwise - = rule { ru_bndrs = bndrs ++ new_bndrs, ru_args = args ++ new_args - , ru_rhs = new_rhs } + = rule { ru_bndrs = bndrs ++ new_bndrs + , ru_args = args ++ new_args + , ru_rhs = new_rhs } + -- new_rhs really ought to be occ-analysed (see GHC.Core Note + -- [OccInfo in unfoldings and rules]), but it makes a module loop to + -- do so; it doesn't happen often; and it doesn't really matter if + -- the outer binders have bogus occurrence info; and new_rhs won't + -- have dead code if rhs didn't. + where need_args = join_arity - length args (new_bndrs, new_rhs) = etaBodyForJoinPoint need_args rhs ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -2165,6 +2165,17 @@ So we have a fast-path that keeps the old tree if the occ_bs_env is empty. This just saves a bit of allocation and reconstruction; not a big deal. +This fast path exposes a tricky cornder, though (#22761). Supose we have + Unfolding = \x. let y = foo in x+1 +which includes a dead binding for `y`. In occAnalUnfolding we occ-anal +the unfolding and produce /no/ occurrences of `foo` (since `y` is +dead). But if we discard the occ-analysed syntax tree (which we do on +our fast path), and use the old one, we still /have/ an occurrence of +`foo` -- and that can lead to out-of-scope variables (#22761). + +Solution: always keep occ-analysed trees in unfoldings and rules, so they +have no dead code. See Note [OccInfo in unfoldings and rules] in GHC.Core. + Note [Cascading inlines] ~~~~~~~~~~~~~~~~~~~~~~~~ By default we use an rhsCtxt for the RHS of a binding. This tells the ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -1065,7 +1065,7 @@ subst_id_bndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) -- See Note [Bangs in the Simplifier] !id1 = uniqAway in_scope old_id !id2 = substIdType env id1 - !id3 = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding + !id3 = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding -- and fragile OccInfo !new_id = adjust_type id3 ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -319,14 +319,14 @@ simplLazyBind :: SimplEnv -> TopLevelFlag -> RecFlag -> InId -> OutId -- Binder, both pre-and post simpl -- Not a JoinId - -- The OutId has IdInfo, except arity, unfolding + -- The OutId has IdInfo (notably RULES), + -- except arity, unfolding -- Ids only, no TyVars -> InExpr -> SimplEnv -- The RHS and its environment -> SimplM (SimplFloats, SimplEnv) -- Precondition: the OutId is already in the InScopeSet of the incoming 'env' -- Precondition: not a JoinId -- Precondition: rhs obeys the let-can-float invariant --- NOT used for JoinIds simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se = assert (isId bndr ) assertPpr (not (isJoinId bndr)) (ppr bndr) $ @@ -398,48 +398,45 @@ simplJoinBind env is_rec cont old_bndr new_bndr rhs rhs_se ; completeBind env (BC_Join is_rec cont) old_bndr new_bndr rhs' } -------------------------- -simplNonRecX :: SimplEnv +simplAuxBind :: SimplEnv -> InId -- Old binder; not a JoinId -> OutExpr -- Simplified RHS -> SimplM (SimplFloats, SimplEnv) --- A specialised variant of simplNonRec used when the RHS is already --- simplified, notably in knownCon. It uses case-binding where necessary. +-- A specialised variant of completeBindX used to construct non-recursive +-- auxiliary bindings, notably in knownCon. +-- +-- The binder comes from a case expression (case binder or alternative) +-- and so does not have rules, inline pragmas etc. -- -- Precondition: rhs satisfies the let-can-float invariant -simplNonRecX env bndr new_rhs - | assertPpr (not (isJoinId bndr)) (ppr bndr) $ +simplAuxBind env bndr new_rhs + | assertPpr (isId bndr && not (isJoinId bndr)) (ppr bndr) $ isDeadBinder bndr -- Not uncommon; e.g. case (a,b) of c { (p,q) -> p } = return (emptyFloats env, env) -- Here c is dead, and we avoid - -- creating the binding c = (a,b) - - | Coercion co <- new_rhs - = return (emptyFloats env, extendCvSubst env bndr co) + -- creating the binding c = (a,b) + -- The cases would be inlined unconditionally by completeBind: + -- but it seems not uncommon, and avoids faff to do it here + -- This is safe because it's only used for auxiliary bindings, which + -- have no NOLINE pragmas, nor RULEs | exprIsTrivial new_rhs -- Short-cut for let x = y in ... - -- This case would ultimately land in postInlineUnconditionally - -- but it seems not uncommon, and avoids a lot of faff to do it here - = return (emptyFloats env - , extendIdSubst env bndr (DoneEx new_rhs Nothing)) + = return ( emptyFloats env + , case new_rhs of + Coercion co -> extendCvSubst env bndr co + _ -> extendIdSubst env bndr (DoneEx new_rhs Nothing) ) | otherwise - = do { (env1, new_bndr) <- simplBinder env bndr - ; let is_strict = isStrictId new_bndr - -- isStrictId: use new_bndr because the InId bndr might not have - -- a fixed runtime representation, which isStrictId doesn't expect - -- c.f. Note [Dark corner with representation polymorphism] - - ; (rhs_floats, rhs1) <- prepareBinding env NotTopLevel NonRecursive is_strict - new_bndr (emptyFloats env) new_rhs - -- NB: it makes a surprisingly big difference (5% in compiler allocation - -- in T9630) to pass 'env' rather than 'env1'. It's fine to pass 'env', - -- because this is simplNonRecX, so bndr is not in scope in the RHS. - - ; (bind_float, env2) <- completeBind (env1 `setInScopeFromF` rhs_floats) - (BC_Let NotTopLevel NonRecursive) + = do { -- ANF-ise the RHS + let !occ_fs = getOccFS bndr + ; (anf_floats, rhs1) <- prepareRhs env NotTopLevel occ_fs new_rhs + ; unless (isEmptyLetFloats anf_floats) (tick LetFloatFromLet) + ; let rhs_floats = emptyFloats env `addLetFloats` anf_floats + + -- Simplify the binder and complete the binding + ; (env1, new_bndr) <- simplBinder (env `setInScopeFromF` rhs_floats) bndr + ; (bind_float, env2) <- completeBind env1 (BC_Let NotTopLevel NonRecursive) bndr new_bndr rhs1 - -- Must pass env1 to completeBind in case simplBinder had to clone, - -- and extended the substitution with [bndr :-> new_bndr] ; return (rhs_floats `addFloats` bind_float, env2) } @@ -761,49 +758,54 @@ prepareRhs :: HasDebugCallStack -- x = Just a -- See Note [prepareRhs] prepareRhs env top_lvl occ rhs0 - = do { (_is_exp, floats, rhs1) <- go 0 rhs0 - ; return (floats, rhs1) } + | is_expandable = anfise rhs0 + | otherwise = return (emptyLetFloats, rhs0) where - go :: Int -> OutExpr -> SimplM (Bool, LetFloats, OutExpr) - go n_val_args (Cast rhs co) - = do { (is_exp, floats, rhs') <- go n_val_args rhs - ; return (is_exp, floats, Cast rhs' co) } - go n_val_args (App fun (Type ty)) - = do { (is_exp, floats, rhs') <- go n_val_args fun - ; return (is_exp, floats, App rhs' (Type ty)) } - go n_val_args (App fun arg) - = do { (is_exp, floats1, fun') <- go (n_val_args+1) fun - ; if is_exp - then do { (floats2, arg') <- makeTrivial env top_lvl topDmd occ arg - ; return (True, floats1 `addLetFlts` floats2, App fun' arg') } - else return (False, emptyLetFloats, App fun arg) - } - go n_val_args (Var fun) - = return (is_exp, emptyLetFloats, Var fun) - where - is_exp = isExpandableApp fun n_val_args -- The fun a constructor or PAP - -- See Note [CONLIKE pragma] in GHC.Types.Basic - -- The definition of is_exp should match that in - -- 'GHC.Core.Opt.OccurAnal.occAnalApp' - - go n_val_args (Tick t rhs) + -- We can' use exprIsExpandable because the WHOLE POINT is that + -- we want to treat (K ) as expandable, because we are just + -- about "anfise" the expression. exprIsExpandable would + -- just say no! + is_expandable = go rhs0 0 + where + go (Var fun) n_val_args = isExpandableApp fun n_val_args + go (App fun arg) n_val_args + | isTypeArg arg = go fun n_val_args + | otherwise = go fun (n_val_args + 1) + go (Cast rhs _) n_val_args = go rhs n_val_args + go (Tick _ rhs) n_val_args = go rhs n_val_args + go _ _ = False + + anfise :: OutExpr -> SimplM (LetFloats, OutExpr) + anfise (Cast rhs co) + = do { (floats, rhs') <- anfise rhs + ; return (floats, Cast rhs' co) } + anfise (App fun (Type ty)) + = do { (floats, rhs') <- anfise fun + ; return (floats, App rhs' (Type ty)) } + anfise (App fun arg) + = do { (floats1, fun') <- anfise fun + ; (floats2, arg') <- makeTrivial env top_lvl topDmd occ arg + ; return (floats1 `addLetFlts` floats2, App fun' arg') } + anfise (Var fun) + = return (emptyLetFloats, Var fun) + + anfise (Tick t rhs) -- We want to be able to float bindings past this -- tick. Non-scoping ticks don't care. | tickishScoped t == NoScope - = do { (is_exp, floats, rhs') <- go n_val_args rhs - ; return (is_exp, floats, Tick t rhs') } + = do { (floats, rhs') <- anfise rhs + ; return (floats, Tick t rhs') } -- On the other hand, for scoping ticks we need to be able to -- copy them on the floats, which in turn is only allowed if -- we can obtain non-counting ticks. | (not (tickishCounts t) || tickishCanSplit t) - = do { (is_exp, floats, rhs') <- go n_val_args rhs + = do { (floats, rhs') <- anfise rhs ; let tickIt (id, expr) = (id, mkTick (mkNoCount t) expr) floats' = mapLetFloats floats tickIt - ; return (is_exp, floats', Tick t rhs') } + ; return (floats', Tick t rhs') } - go _ other - = return (False, emptyLetFloats, other) + anfise other = return (emptyLetFloats, other) makeTrivialArg :: HasDebugCallStack => SimplEnv -> ArgSpec -> SimplM (LetFloats, ArgSpec) makeTrivialArg env arg@(ValArg { as_arg = e, as_dmd = dmd }) @@ -1244,7 +1246,7 @@ simplExprF1 env (Let (NonRec bndr rhs) body) cont | otherwise = {-#SCC "simplNonRecE" #-} - simplNonRecE env False bndr (rhs, env) body cont + simplNonRecE env FromLet bndr (rhs, env) body cont {- Note [Avoiding space leaks in OutType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1505,8 +1507,9 @@ rebuild env expr cont StrictArg { sc_fun = fun, sc_cont = cont, sc_fun_ty = fun_ty } -> rebuildCall env (addValArgTo fun expr fun_ty ) cont - StrictBind { sc_bndr = b, sc_body = body, sc_env = se, sc_cont = cont } - -> completeBindX (se `setInScopeFromE` env) b expr body cont + StrictBind { sc_bndr = b, sc_body = body, sc_env = se + , sc_cont = cont, sc_from = from_what } + -> completeBindX (se `setInScopeFromE` env) from_what b expr body cont ApplyToTy { sc_arg_ty = ty, sc_cont = cont} -> rebuild env (App expr (Type ty)) cont @@ -1518,25 +1521,48 @@ rebuild env expr cont ; rebuild env (App expr arg') cont } completeBindX :: SimplEnv + -> FromWhat -> InId -> OutExpr -- Bind this Id to this (simplified) expression -- (the let-can-float invariant may not be satisfied) - -> InExpr -- In this lambda + -> InExpr -- In this body -> SimplCont -- Consumed by this continuation -> SimplM (SimplFloats, OutExpr) -completeBindX env bndr rhs body cont - | needsCaseBinding (idType bndr) rhs -- Enforcing the let-can-float-invariant - = do { (env1, bndr1) <- simplNonRecBndr env bndr - ; (floats, expr') <- simplLam env1 body cont +completeBindX env from_what bndr rhs body cont + | FromBeta arg_ty <- from_what + , needsCaseBinding arg_ty rhs -- Enforcing the let-can-float-invariant + = do { (env1, bndr1) <- simplNonRecBndr env bndr -- Lambda binders don't have rules + ; (floats, expr') <- simplNonRecBody env1 from_what body cont -- Do not float floats past the Case binder below ; let expr'' = wrapFloats floats expr' - ; let case_expr = Case rhs bndr1 (contResultType cont) [Alt DEFAULT [] expr''] + case_expr = Case rhs bndr1 (contResultType cont) [Alt DEFAULT [] expr''] ; return (emptyFloats env, case_expr) } - | otherwise - = do { (floats1, env') <- simplNonRecX env bndr rhs - ; (floats2, expr') <- simplLam env' body cont - ; return (floats1 `addFloats` floats2, expr') } + | otherwise -- Make a let-binding + = do { (env1, bndr1) <- simplNonRecBndr env bndr + ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) + + ; let is_strict = isStrictId bndr2 + -- isStrictId: use simplified binder because the InId bndr might not have + -- a fixed runtime representation, which isStrictId doesn't expect + -- c.f. Note [Dark corner with representation polymorphism] + + ; (rhs_floats, rhs1) <- prepareBinding env NotTopLevel NonRecursive is_strict + bndr2 (emptyFloats env) rhs + -- NB: it makes a surprisingly big difference (5% in compiler allocation + -- in T9630) to pass 'env' rather than 'env1'. It's fine to pass 'env', + -- because this is simplNonRecX, so bndr is not in scope in the RHS. + + ; (bind_float, env2) <- completeBind (env2 `setInScopeFromF` rhs_floats) + (BC_Let NotTopLevel NonRecursive) + bndr bndr2 rhs1 + -- Must pass env1 to completeBind in case simplBinder had to clone, + -- and extended the substitution with [bndr :-> new_bndr] + + -- Simplify the body + ; (body_floats, body') <- simplNonRecBody env2 from_what body cont + ; let all_floats = rhs_floats `addFloats` bind_float `addFloats` body_floats + ; return ( all_floats, body' ) } {- ************************************************************************ @@ -1674,6 +1700,14 @@ simplArg env dup_flag fun_ty arg_env arg ************************************************************************ -} +simplNonRecBody :: SimplEnv -> FromWhat + -> InExpr -> SimplCont + -> SimplM (SimplFloats, OutExpr) +simplNonRecBody env from_what body cont + = case from_what of + FromLet -> simplExprF env body cont + FromBeta {} -> simplLam env body cont + simplLam :: SimplEnv -> InExpr -> SimplCont -> SimplM (SimplFloats, OutExpr) @@ -1690,15 +1724,24 @@ simpl_lam env bndr body (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = cont }) -- Value beta-reduction simpl_lam env bndr body (ApplyToVal { sc_arg = arg, sc_env = arg_se - , sc_cont = cont, sc_dup = dup }) - | isSimplified dup -- Don't re-simplify if we've simplified it once - -- See Note [Avoiding exponential behaviour] + , sc_cont = cont, sc_dup = dup + , sc_hole_ty = fun_ty}) = do { tick (BetaReduction bndr) - ; completeBindX env bndr arg body cont } + ; let arg_ty = funArgTy fun_ty + ; if | isSimplified dup -- Don't re-simplify if we've simplified it once + -- Including don't preInlineUnconditionally + -- See Note [Avoiding exponential behaviour] + -> completeBindX env (FromBeta arg_ty) bndr arg body cont + + | Just env' <- preInlineUnconditionally env NotTopLevel bndr arg arg_se + , not (needsCaseBinding arg_ty arg) + -- Ok to test arg::InExpr in needsCaseBinding because + -- exprOkForSpeculation is stable under simplification + -> do { tick (PreInlineUnconditionally bndr) + ; simplLam env' body cont } - | otherwise -- See Note [Avoiding exponential behaviour] - = do { tick (BetaReduction bndr) - ; simplNonRecE env True bndr (arg, arg_se) body cont } + | otherwise + -> simplNonRecE env (FromBeta arg_ty) bndr (arg, arg_se) body cont } -- Discard a non-counting tick on a lambda. This may change the -- cost attribution slightly (moving the allocation of the @@ -1730,8 +1773,7 @@ simplLamBndrs env bndrs = mapAccumLM simplLamBndr env bndrs ------------------ simplNonRecE :: SimplEnv - -> Bool -- True <=> from a lambda - -- False <=> from a let + -> FromWhat -> InId -- The binder, always an Id -- Never a join point -> (InExpr, SimplEnv) -- Rhs of binding (or arg of lambda) @@ -1740,56 +1782,48 @@ simplNonRecE :: SimplEnv -> SimplM (SimplFloats, OutExpr) -- simplNonRecE is used for --- * non-top-level non-recursive non-join-point lets in expressions --- * beta reduction +-- * from=FromLet: a non-top-level non-recursive non-join-point let-expression +-- * from=FromBeta: a binding arising from a beta reduction -- --- simplNonRec env b (rhs, rhs_se) body k +-- simplNonRecE env b (rhs, rhs_se) body k -- = let env in -- cont< let b = rhs_se(rhs) in body > -- -- It deals with strict bindings, via the StrictBind continuation, -- which may abort the whole process. -- --- from_lam=False => the RHS satisfies the let-can-float invariant +-- from_what=FromLet => the RHS satisfies the let-can-float invariant -- Otherwise it may or may not satisfy it. -simplNonRecE env from_lam bndr (rhs, rhs_se) body cont - = assert (isId bndr && not (isJoinId bndr) ) $ - do { (env1, bndr1) <- simplNonRecBndr env bndr - ; let needs_case_binding = needsCaseBinding (idType bndr1) rhs - -- See Note [Dark corner with representation polymorphism] - -- If from_lam=False then needs_case_binding is False, - -- because the binding started as a let, which must - -- satisfy let-can-float - - ; if | from_lam && not needs_case_binding - -- If not from_lam we are coming from a (NonRec bndr rhs) binding - -- and preInlineUnconditionally has been done already; - -- no need to repeat it. But for lambdas we must be careful about - -- preInlineUndonditionally: consider (\(x:Int#). 3) (error "urk") - -- We must not drop the (error "urk"). - , Just env' <- preInlineUnconditionally env NotTopLevel bndr rhs rhs_se - -> do { tick (PreInlineUnconditionally bndr) - ; -- pprTrace "preInlineUncond" (ppr bndr <+> ppr rhs) $ - simplLam env' body cont } - - -- Deal with strict bindings - | isStrictId bndr1 && seCaseCase env - || from_lam && needs_case_binding - -- The important bit here is needs_case_binds; but no need to - -- test it if from_lam is False because then needs_case_binding is False too - -- NB: either way, the RHS may or may not satisfy let-can-float - -- but that's ok for StrictBind. - -> simplExprF (rhs_se `setInScopeFromE` env) rhs - (StrictBind { sc_bndr = bndr, sc_body = body - , sc_env = env, sc_cont = cont, sc_dup = NoDup }) - - -- Deal with lazy bindings - | otherwise - -> do { (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) - ; (floats1, env3) <- simplLazyBind env2 NotTopLevel NonRecursive bndr bndr2 rhs rhs_se - ; (floats2, expr') <- simplLam env3 body cont - ; return (floats1 `addFloats` floats2, expr') } } +simplNonRecE env from_what bndr (rhs, rhs_se) body cont + | assert (isId bndr && not (isJoinId bndr) ) $ + is_strict_bind + = -- Evaluate RHS strictly + simplExprF (rhs_se `setInScopeFromE` env) rhs + (StrictBind { sc_bndr = bndr, sc_body = body, sc_from = from_what + , sc_env = env, sc_cont = cont, sc_dup = NoDup }) + + | otherwise -- Evaluate RHS lazily + = do { (env1, bndr1) <- simplNonRecBndr env bndr + ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) + ; (floats1, env3) <- simplLazyBind env2 NotTopLevel NonRecursive + bndr bndr2 rhs rhs_se + ; (floats2, expr') <- simplNonRecBody env3 from_what body cont + ; return (floats1 `addFloats` floats2, expr') } + + where + is_strict_bind = case from_what of + FromBeta arg_ty | isUnliftedType arg_ty -> True + -- If we are coming from a beta-reduction (FromBeta) we must + -- establish the let-can-float invariant, so go via StrictBind + -- If not, the invariant holds already, and it's optional. + -- Using arg_ty: see Note [Dark corner with representation polymorphism] + -- e.g (\r \(a::TYPE r) \(x::a). blah) @LiftedRep @Int arg + -- When we come to `x=arg` we myst choose lazy/strict correctly + -- It's wrong to err in either directly + + _ -> seCaseCase env && isStrUsedDmd (idDemandInfo bndr) + ------------------ simplRecE :: SimplEnv @@ -1835,7 +1869,7 @@ Note [Avoiding exponential behaviour] One way in which we can get exponential behaviour is if we simplify a big expression, and then re-simplify it -- and then this happens in a deeply-nested way. So we must be jolly careful about re-simplifying -an expression. That is why simplNonRecX does not try +an expression (#13379). That is why simplNonRecX does not try preInlineUnconditionally (unlike simplNonRecE). Example: @@ -2618,15 +2652,10 @@ Is this inefficient? Not really: we are about to walk over the result of the rule firing to simplify it, so occurrence analysis is at most a constant factor. -Possible improvement: occ-anal the rules when putting them in the -database; and in the simplifier just occ-anal the OutExpr arguments. -But that's more complicated and the rule RHS is usually tiny; so I'm -just doing the simple thing. - -Historical note: previously we did occ-anal the rules in Rule.hs, -but failed to occ-anal the OutExpr arguments, which led to the -nasty performance problem described above. - +Note, however, that the rule RHS is /already/ occ-analysed; see +Note [OccInfo in unfoldings and rules] in GHC.Core. There is something +unsatisfactory about doing it twice; but the rule RHS is usually very +small, and this is simple. Note [Optimising tagToEnum#] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2930,7 +2959,7 @@ rebuildCase env scrut case_bndr alts cont where simple_rhs env wfloats case_bndr_rhs bs rhs = assert (null bs) $ - do { (floats1, env') <- simplNonRecX env case_bndr case_bndr_rhs + do { (floats1, env') <- simplAuxBind env case_bndr case_bndr_rhs -- scrut is a constructor application, -- hence satisfies let-can-float invariant ; (floats2, expr') <- simplExprF env' rhs cont @@ -2997,7 +3026,7 @@ rebuildCase env scrut case_bndr alts@[Alt _ bndrs rhs] cont | all_dead_bndrs , doCaseToLet scrut case_bndr = do { tick (CaseElim case_bndr) - ; (floats1, env') <- simplNonRecX env case_bndr scrut + ; (floats1, env') <- simplAuxBind env case_bndr scrut ; (floats2, expr') <- simplExprF env' rhs cont ; return (floats1 `addFloats` floats2, expr') } @@ -3483,12 +3512,11 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont bind_args env' (b:bs') (arg : args) = assert (isId b) $ do { let b' = zap_occ b - -- Note that the binder might be "dead", because it doesn't - -- occur in the RHS; and simplNonRecX may therefore discard - -- it via postInlineUnconditionally. + -- zap_occ: the binder might be "dead", because it doesn't + -- occur in the RHS; and simplAuxBind may therefore discard it. -- Nevertheless we must keep it if the case-binder is alive, -- because it may be used in the con_app. See Note [knownCon occ info] - ; (floats1, env2) <- simplNonRecX env' b' arg -- arg satisfies let-can-float invariant + ; (floats1, env2) <- simplAuxBind env' b' arg -- arg satisfies let-can-float invariant ; (floats2, env3) <- bind_args env2 bs' args ; return (floats1 `addFloats` floats2, env3) } @@ -3514,7 +3542,7 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont ; let con_app = Var (dataConWorkId dc) `mkTyApps` dc_ty_args `mkApps` dc_args - ; simplNonRecX env bndr con_app } + ; simplAuxBind env bndr con_app } ------------------- missingAlt :: SimplEnv -> Id -> [InAlt] -> SimplCont @@ -3621,15 +3649,15 @@ mkDupableContWithDmds env dmds (TickIt t cont) ; return (floats, TickIt t cont') } mkDupableContWithDmds env _ - (StrictBind { sc_bndr = bndr, sc_body = body + (StrictBind { sc_bndr = bndr, sc_body = body, sc_from = from_what , sc_env = se, sc_cont = cont}) -- See Note [Duplicating StrictBind] -- K[ let x = <> in b ] --> join j x = K[ b ] -- j <> = do { let sb_env = se `setInScopeFromE` env ; (sb_env1, bndr') <- simplBinder sb_env bndr - ; (floats1, join_inner) <- simplLam sb_env1 body cont - -- No need to use mkDupableCont before simplLam; we + ; (floats1, join_inner) <- simplNonRecBody sb_env1 from_what body cont + -- No need to use mkDupableCont before simplNonRecBody; we -- use cont once here, and then share the result if necessary ; let join_body = wrapFloats floats1 join_inner @@ -3757,6 +3785,7 @@ mkDupableStrictBind env arg_bndr join_rhs res_ty , StrictBind { sc_bndr = arg_bndr , sc_body = join_rhs , sc_env = zapSubstEnv env + , sc_from = FromLet -- See Note [StaticEnv invariant] in GHC.Core.Opt.Simplify.Utils , sc_dup = OkToDup , sc_cont = mkBoringStop res_ty } ) @@ -4430,7 +4459,9 @@ simplRules env mb_new_id rules bind_cxt ; return (rule { ru_bndrs = bndrs' , ru_fn = fn_name' , ru_args = args' - , ru_rhs = rhs' }) } + , ru_rhs = occurAnalyseExpr rhs' }) } + -- Remember to occ-analyse, to drop dead code. + -- See Note [OccInfo in unfoldings and rules] in GHC.Core {- Note [Simplifying the RHS of a RULE] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -21,7 +21,7 @@ module GHC.Core.Opt.Simplify.Utils ( BindContext(..), bindContextLevel, -- The continuation type - SimplCont(..), DupFlag(..), StaticEnv, + SimplCont(..), DupFlag(..), FromWhat(..), StaticEnv, isSimplified, contIsStop, contIsDupable, contResultType, contHoleType, contHoleScaling, contIsTrivial, contArgs, contIsRhs, @@ -192,6 +192,7 @@ data SimplCont -- or, equivalently, = K[ (\x.b) e ] { sc_dup :: DupFlag -- See Note [DupFlag invariants] , sc_bndr :: InId + , sc_from :: FromWhat , sc_body :: InExpr , sc_env :: StaticEnv -- See Note [StaticEnv invariant] , sc_cont :: SimplCont } @@ -213,6 +214,8 @@ data SimplCont type StaticEnv = SimplEnv -- Just the static part is relevant +data FromWhat = FromLet | FromBeta OutType + -- See Note [DupFlag invariants] data DupFlag = NoDup -- Unsimplified, might be big | Simplified -- Simplified ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -63,6 +63,7 @@ import GHC.Core.Tidy ( tidyRules ) import GHC.Core.Map.Expr ( eqCoreExpr ) import GHC.Core.Opt.Arity( etaExpandToJoinPointRule ) import GHC.Core.Make ( mkCoreLams ) +import GHC.Core.Opt.OccurAnal( occurAnalyseExpr ) import GHC.Tc.Utils.TcType ( tcSplitTyConApp_maybe ) import GHC.Builtin.Types ( anyTypeOfKind ) @@ -189,13 +190,18 @@ mkRule :: Module -> Bool -> Bool -> RuleName -> Activation -- ^ Used to make 'CoreRule' for an 'Id' defined in the module being -- compiled. See also 'GHC.Core.CoreRule' mkRule this_mod is_auto is_local name act fn bndrs args rhs - = Rule { ru_name = name, ru_fn = fn, ru_act = act, - ru_bndrs = bndrs, ru_args = args, - ru_rhs = rhs, - ru_rough = roughTopNames args, - ru_origin = this_mod, - ru_orphan = orph, - ru_auto = is_auto, ru_local = is_local } + = Rule { ru_name = name + , ru_act = act + , ru_fn = fn + , ru_bndrs = bndrs + , ru_args = args + , ru_rhs = occurAnalyseExpr rhs + -- See Note [OccInfo in unfoldings and rules] + , ru_rough = roughTopNames args + , ru_origin = this_mod + , ru_orphan = orph + , ru_auto = is_auto + , ru_local = is_local } where -- Compute orphanhood. See Note [Orphans] in GHC.Core.InstEnv -- A rule is an orphan only if none of the variables ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -513,8 +513,8 @@ bindNonRec bndr rhs body -- | Tests whether we have to use a @case@ rather than @let@ binding for this -- expression as per the invariants of 'CoreExpr': see "GHC.Core#let_can_float_invariant" needsCaseBinding :: Type -> CoreExpr -> Bool -needsCaseBinding ty rhs = - mightBeUnliftedType ty && not (exprOkForSpeculation rhs) +needsCaseBinding ty rhs + = mightBeUnliftedType ty && not (exprOkForSpeculation rhs) -- Make a case expression instead of a let -- These can arise either from the desugarer, -- or from beta reductions: (\x.e) (x +# y) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4939,6 +4939,7 @@ needSourceNotes dflags = debugLevel dflags > 0 -- LinkerInfo contains any extra options needed by the system linker. data LinkerInfo = GnuLD [Option] + | Mold [Option] | GnuGold [Option] | LlvmLLD [Option] | DarwinLD [Option] ===================================== compiler/GHC/SysTools/Info.hs ===================================== @@ -70,6 +70,7 @@ The flag is only needed on ELF systems. On Windows (PE) and Mac OS X neededLinkArgs :: LinkerInfo -> [Option] neededLinkArgs (GnuLD o) = o +neededLinkArgs (Mold o) = o neededLinkArgs (GnuGold o) = o neededLinkArgs (LlvmLLD o) = o neededLinkArgs (DarwinLD o) = o @@ -106,6 +107,10 @@ getLinkerInfo' logger dflags = do -- see Note [ELF needed shared libs] "-Wl,--no-as-needed"]) + | any ("mold" `isPrefixOf`) stdo = + return (Mold $ map Option [ --see Note [ELF needed shared libs] + "-Wl,--no-as-needed"]) + | any ("GNU gold" `isPrefixOf`) stdo = -- GNU gold only needs --no-as-needed. #10110. -- ELF specific flag, see Note [ELF needed shared libs] ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -723,12 +723,14 @@ setIdCprSig id sig = modifyIdInfo (\info -> setCprSigInfo info sig) id zapIdDmdSig :: Id -> Id zapIdDmdSig id = modifyIdInfo (`setDmdSigInfo` nopSig) id --- | This predicate says whether the 'Id' has a strict demand placed on it or --- has a type such that it can always be evaluated strictly (i.e an --- unlifted type, as of GHC 7.6). We need to --- check separately whether the 'Id' has a so-called \"strict type\" because if --- the demand for the given @id@ hasn't been computed yet but @id@ has a strict --- type, we still want @isStrictId id@ to be @True at . +-- | `isStrictId` says whether either +-- (a) the 'Id' has a strict demand placed on it or +-- (b) definitely has a \"strict type\", such that it can always be +-- evaluated strictly (i.e an unlifted type) +-- We need to check (b) as well as (a), because when the demand for the +-- given `id` hasn't been computed yet but `id` has a strict +-- type, we still want `isStrictId id` to be `True`. +-- Returns False if the type is levity polymorphic; False is always safe. isStrictId :: Id -> Bool isStrictId id | assertPpr (isId id) (text "isStrictId: not an id: " <+> ppr id) $ ===================================== testsuite/tests/simplCore/should_compile/T22761.hs ===================================== @@ -0,0 +1,40 @@ +module T22761 where + +import T22761a + +newtype Mod m = Mod m deriving Num + +gcdExt :: Integer -> (Integer, Integer) +gcdExt x = go 0 x + where + go !_ 0 = (1, 1) + go r _ = go r r + +pow :: (Num m) => Mod m -> Mod m +pow x = x*x*x +{-# NOINLINE [1] pow #-} +{-# RULES +"powMod/3/Int" forall x. pow x = x*x*x +#-} + + +-- GHC puts `boo1` after `wom1` (since they don't appear connected) +-- Then { wom1 = foo True } rewrites to { wom1 = boo False } +-- so we need to do glomming. And that triggers the bug +-- in the RULE for `pow`! +-- +-- wom2/boo2 are there to still elicit the bug if +-- GHC reverses its default ordering + +{-# RULES +"wombat1" foo True = boo1 False +#-} + +wom1 = foo True +boo1 x = x + +{-# RULES +"wombat2" foo True = boo2 False +#-} +boo2 x = x +wom2 = foo True ===================================== testsuite/tests/simplCore/should_compile/T22761a.hs ===================================== @@ -0,0 +1,4 @@ +module T22761a where + +{-# NOINLINE [0] foo #-} +foo x = x ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -471,5 +471,6 @@ test('T22611', [when(wordsize(32), skip), grep_errmsg(r'\$salterF') ], compile, test('T22715_2', normal, multimod_compile, ['T22715_2', '-v0 -O -fspecialise-aggressively']) test('T22802', normal, compile, ['-O']) test('T15205', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) +test('T22761', normal, multimod_compile, ['T22761', '-O2 -v0']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d4a099d28f3ba9f4df563083b3f2014d6d154a76...f8370c8b77ba1a7db7db0474139ac70565e2b0ba -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d4a099d28f3ba9f4df563083b3f2014d6d154a76...f8370c8b77ba1a7db7db0474139ac70565e2b0ba You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 10 09:18:31 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Fri, 10 Feb 2023 04:18:31 -0500 Subject: [Git][ghc/ghc][wip/js-rts-fixmes] JS RTS: use jsClosureCount for closureConstructors and cache sizes Message-ID: <63e60be7add0e_2b039a5276064331f@gitlab.mail> Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC Commits: 70ef6b07 by Josh Meredith at 2023-02-10T09:18:16+00:00 JS RTS: use jsClosureCount for closureConstructors and cache sizes - - - - - 3 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -131,8 +131,9 @@ module GHC.JS.Make , allocData, allocClsA , dataName , clsName - , dataFieldName, dataFieldNames - , varName, varNames + , dataFieldName + , varName + , jsClosureCount ) where @@ -145,10 +146,8 @@ import Control.Arrow ((***)) import Data.Array import qualified Data.Map as M -import GHC.Utils.Outputable (Outputable (..)) import GHC.Data.FastString import GHC.Utils.Monad.State.Strict -import GHC.Utils.Panic import GHC.Utils.Misc import GHC.Types.Unique.Map @@ -647,50 +646,46 @@ dataFieldCache = listArray (0,nFieldCache) (map (mkFastString . ('d':) . show) [ nFieldCache :: Int nFieldCache = 16384 +jsClosureCount :: Int +jsClosureCount = 24 + dataFieldName :: Int -> FastString dataFieldName i - | i < 0 || i > nFieldCache = panic "dataFieldName" (ppr i) + | i < 0 || i > nFieldCache = mkFastString ('d' : show i) | otherwise = dataFieldCache ! i -dataFieldNames :: [FastString] -dataFieldNames = fmap dataFieldName [1..nFieldCache] - - -- | Cache "h$dXXX" names dataCache :: Array Int FastString -dataCache = listArray (0,63) (map (mkFastString . ("h$d"++) . show) [(0::Int)..63]) +dataCache = listArray (0,jsClosureCount) (map (mkFastString . ("h$d"++) . show) [(0::Int)..jsClosureCount]) dataName :: Int -> FastString dataName i - | i < 0 || i > 63 = panic "dataCacheName" (ppr i) - | otherwise = dataCache ! i + | i < 0 || i > nFieldCache = mkFastString ("h$d" ++ show i) + | otherwise = dataCache ! i allocData :: Int -> JExpr allocData i = toJExpr (TxtI (dataCache ! i)) -- | Cache "h$cXXX" names clsCache :: Array Int FastString -clsCache = listArray (0,63) (map (mkFastString . ("h$c"++) . show) [(0::Int)..63]) +clsCache = listArray (0,jsClosureCount) (map (mkFastString . ("h$c"++) . show) [(0::Int)..jsClosureCount]) clsName :: Int -> FastString clsName i - | i < 0 || i > 63 = panic "clsCacheName" (ppr i) - | otherwise = clsCache ! i + | i < 0 || i > jsClosureCount = mkFastString ("h$c" ++ show i) + | otherwise = clsCache ! i allocClsA :: Int -> JExpr -allocClsA i = toJExpr (TxtI (clsCache ! i)) +allocClsA i = toJExpr (TxtI (clsName i)) -- | Cache "xXXX" names -varCache :: Array Int FastString -varCache = listArray (0,63) (map (mkFastString . ('x':) . show) [(0::Int)..63]) +varCache :: Array Int Ident +varCache = listArray (0,jsClosureCount) (map (TxtI . mkFastString . ('x':) . show) [(0::Int)..jsClosureCount]) varName :: Int -> Ident varName i - | i < 0 || i > 63 = panic "varCacheName" (ppr i) - | otherwise = TxtI $ varCache ! i - -varNames :: [Ident] -varNames = fmap varName [1..63] + | i < 0 || i > jsClosureCount = TxtI $ mkFastString ('x' : show i) + | otherwise = varCache ! i -------------------------------------------------------------------------------- ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -1006,7 +1006,7 @@ allocDynAll haveDecl middle cls = do ] (ex:es) -> mconcat [ toJExpr i .^ closureField1_ |= toJExpr ex - , toJExpr i .^ closureField2_ |= toJExpr (jhFromList (zip dataFieldNames es)) + , toJExpr i .^ closureField2_ |= toJExpr (jhFromList (zip (map dataFieldName [1..]) es)) ] | otherwise = case es of [] -> mempty ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -81,8 +81,8 @@ resetResultVar r = toJExpr r |= null_ -- JIT can optimize better. closureConstructors :: StgToJSConfig -> JStat closureConstructors s = BlockStat - [ mconcat (map mkClosureCon (Nothing : map Just [0..24])) - , mconcat (map mkDataFill [1..24]) + [ mconcat (map mkClosureCon (Nothing : map Just [0..jsClosureCount])) + , mconcat (map mkDataFill [1..jsClosureCount]) ] where prof = csProf s @@ -141,12 +141,12 @@ closureConstructors s = BlockStat funName | Just n' <- n0 = TxtI $ clsName n' | Nothing <- n0 = TxtI $ mkFastString "h$c" -- args are: f x1 x2 .. xn [cc] - args = TxtI "f" : addCCArg' (take n varNames) + args = TxtI "f" : addCCArg' (map varName [1..n]) fun = JFunc args funBod -- x1 goes into closureField1. All the other args are bundled into an -- object in closureField2: { d1 = x2, d2 = x3, ... } -- - vars = map toJExpr $ take n varNames + vars = map (toJExpr . varName) [1..n] x1 = case vars of [] -> null_ @@ -155,7 +155,7 @@ closureConstructors s = BlockStat [] -> null_ [_] -> null_ [_,x] -> x - _:x:xs -> ValExpr . JHash . listToUniqMap $ zip dataFieldNames (x:xs) + _:x:xs -> ValExpr . JHash . listToUniqMap $ zip (map dataFieldName [1..]) (x:xs) funBod = jVar $ \x -> [ checkC @@ -175,7 +175,7 @@ closureConstructors s = BlockStat mkDataFill n = funName ||= toJExpr fun where funName = TxtI $ dataName n - ds = take n dataFieldNames + ds = map dataFieldName [1..n] extra_args = ValExpr . JHash . listToUniqMap . zip ds $ map (toJExpr . TxtI) ds fun = JFunc (map TxtI ds) (checkD <> returnS extra_args) @@ -186,7 +186,7 @@ stackManip = mconcat (map mkPush [1..32]) <> where mkPush :: Int -> JStat mkPush n = let funName = TxtI $ mkFastString ("h$p" ++ show n) - as = take n varNames + as = map varName [1..n] fun = JFunc as ((sp |= sp + toJExpr n) <> mconcat (zipWith (\i a -> stack .! (sp - toJExpr (n-i)) |= toJExpr a) [1..] as)) @@ -199,7 +199,7 @@ stackManip = mconcat (map mkPush [1..32]) <> bits = bitsIdx sig n = length bits h = last bits - args = take n varNames + args = map varName [1..n] fun = JFunc args $ mconcat [ sp |= sp + toJExpr (h+1) , mconcat (zipWith (\b a -> stack .! (sp - toJExpr (h-b)) |= toJExpr a) bits args) @@ -259,7 +259,7 @@ loadRegs :: JStat loadRegs = mconcat $ map mkLoad [1..32] where mkLoad :: Int -> JStat - mkLoad n = let args = take n varNames + mkLoad n = let args = map varName [1..n] assign = zipWith (\a r -> toJExpr r |= toJExpr a) args (reverse $ take n regsFromR1) fname = TxtI $ mkFastString ("h$l" ++ show n) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/70ef6b07d4adfc62b7d2cac4c7bc6a46b684490e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/70ef6b07d4adfc62b7d2cac4c7bc6a46b684490e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 10 10:35:22 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 10 Feb 2023 05:35:22 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/general-catgeory Message-ID: <63e61dea9266e_2b039a9b5ac806802f4@gitlab.mail> Matthew Pickering pushed new branch wip/general-catgeory at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/general-catgeory You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 10 11:51:54 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 10 Feb 2023 06:51:54 -0500 Subject: [Git][ghc/ghc][master] Refactor the simplifier a bit to fix #22761 Message-ID: <63e62fda99671_2b039a9b5ac80694998@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 12 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Types/Id.hs - + testsuite/tests/simplCore/should_compile/T22761.hs - + testsuite/tests/simplCore/should_compile/T22761a.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -1300,16 +1300,19 @@ data Unfolding df_args :: [CoreExpr] -- Args of the data con: types, superclasses and methods, } -- in positional order - | CoreUnfolding { -- An unfolding for an Id with no pragma, - -- or perhaps a NOINLINE pragma - -- (For NOINLINE, the phase, if any, is in the - -- InlinePragInfo for this Id.) - uf_tmpl :: CoreExpr, -- Template; occurrence info is correct - uf_src :: UnfoldingSource, -- Where the unfolding came from - uf_is_top :: Bool, -- True <=> top level binding - uf_cache :: UnfoldingCache, -- Cache of flags computable from the expr - -- See Note [Tying the 'CoreUnfolding' knot] - uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template. + | CoreUnfolding { -- An unfolding for an Id with no pragma, + -- or perhaps a NOINLINE pragma + -- (For NOINLINE, the phase, if any, is in the + -- InlinePragInfo for this Id.) + uf_tmpl :: CoreExpr, -- The unfolding itself (aka "template") + -- Always occ-analysed; + -- See Note [OccInfo in unfoldings and rules] + + uf_src :: UnfoldingSource, -- Where the unfolding came from + uf_is_top :: Bool, -- True <=> top level binding + uf_cache :: UnfoldingCache, -- Cache of flags computable from the expr + -- See Note [Tying the 'CoreUnfolding' knot] + uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template. } -- ^ An unfolding with redundant cached information. Parameters: -- @@ -1637,14 +1640,37 @@ change was requested by Roman, but it seems to make sense. Note [OccInfo in unfoldings and rules] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In unfoldings and rules, we guarantee that the template is occ-analysed, -so that the occurrence info on the binders is correct. This is important, -because the Simplifier does not re-analyse the template when using it. If -the occurrence info is wrong - - We may get more simplifier iterations than necessary, because - once-occ info isn't there - - More seriously, we may get an infinite loop if there's a Rec - without a loop breaker marked +In unfoldings and rules, we guarantee that the template is occ-analysed, so +that the occurrence info on the binders is correct. That way, when the +Simplifier inlines an unfolding, it doesn't need to occ-analysis it first. +(The Simplifier is designed to simplify occ-analysed expressions.) + +Given this decision it's vital that we do *always* do it. + +* If we don't, we may get more simplifier iterations than necessary, + because once-occ info isn't there + +* More seriously, we may get an infinite loop if there's a Rec without a + loop breaker marked. + +* Or we may get code that mentions variables not in scope: #22761 + e.g. Suppose we have a stable unfolding : \y. let z = p+1 in 3 + Then the pre-simplifier occ-anal will occ-anal the unfolding + (redundantly perhaps, but we need its free vars); this will not report + the use of `p`; so p's binding will be discarded, and yet `p` is still + mentioned. + + Better to occ-anal the unfolding at birth, which will drop the + z-binding as dead code. (Remember, it's the occurrence analyser that + drops dead code.) + +* Another example is #8892: + \x -> letrec { f = ...g...; g* = f } in body + where g* is (for some strange reason) the loop breaker. If we don't + occ-anal it when reading it in, we won't mark g as a loop breaker, and we + may inline g entirely in body, dropping its binding, and leaving the + occurrence in f out of scope. This happened in #8892, where the unfolding + in question was a DFun unfolding. ************************************************************************ ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -3088,8 +3088,15 @@ etaExpandToJoinPointRule join_arity rule@(Rule { ru_bndrs = bndrs, ru_rhs = rhs | need_args < 0 = pprPanic "etaExpandToJoinPointRule" (ppr join_arity $$ ppr rule) | otherwise - = rule { ru_bndrs = bndrs ++ new_bndrs, ru_args = args ++ new_args - , ru_rhs = new_rhs } + = rule { ru_bndrs = bndrs ++ new_bndrs + , ru_args = args ++ new_args + , ru_rhs = new_rhs } + -- new_rhs really ought to be occ-analysed (see GHC.Core Note + -- [OccInfo in unfoldings and rules]), but it makes a module loop to + -- do so; it doesn't happen often; and it doesn't really matter if + -- the outer binders have bogus occurrence info; and new_rhs won't + -- have dead code if rhs didn't. + where need_args = join_arity - length args (new_bndrs, new_rhs) = etaBodyForJoinPoint need_args rhs ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -2165,6 +2165,17 @@ So we have a fast-path that keeps the old tree if the occ_bs_env is empty. This just saves a bit of allocation and reconstruction; not a big deal. +This fast path exposes a tricky cornder, though (#22761). Supose we have + Unfolding = \x. let y = foo in x+1 +which includes a dead binding for `y`. In occAnalUnfolding we occ-anal +the unfolding and produce /no/ occurrences of `foo` (since `y` is +dead). But if we discard the occ-analysed syntax tree (which we do on +our fast path), and use the old one, we still /have/ an occurrence of +`foo` -- and that can lead to out-of-scope variables (#22761). + +Solution: always keep occ-analysed trees in unfoldings and rules, so they +have no dead code. See Note [OccInfo in unfoldings and rules] in GHC.Core. + Note [Cascading inlines] ~~~~~~~~~~~~~~~~~~~~~~~~ By default we use an rhsCtxt for the RHS of a binding. This tells the ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -1065,7 +1065,7 @@ subst_id_bndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) -- See Note [Bangs in the Simplifier] !id1 = uniqAway in_scope old_id !id2 = substIdType env id1 - !id3 = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding + !id3 = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding -- and fragile OccInfo !new_id = adjust_type id3 ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -319,14 +319,14 @@ simplLazyBind :: SimplEnv -> TopLevelFlag -> RecFlag -> InId -> OutId -- Binder, both pre-and post simpl -- Not a JoinId - -- The OutId has IdInfo, except arity, unfolding + -- The OutId has IdInfo (notably RULES), + -- except arity, unfolding -- Ids only, no TyVars -> InExpr -> SimplEnv -- The RHS and its environment -> SimplM (SimplFloats, SimplEnv) -- Precondition: the OutId is already in the InScopeSet of the incoming 'env' -- Precondition: not a JoinId -- Precondition: rhs obeys the let-can-float invariant --- NOT used for JoinIds simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se = assert (isId bndr ) assertPpr (not (isJoinId bndr)) (ppr bndr) $ @@ -398,48 +398,45 @@ simplJoinBind env is_rec cont old_bndr new_bndr rhs rhs_se ; completeBind env (BC_Join is_rec cont) old_bndr new_bndr rhs' } -------------------------- -simplNonRecX :: SimplEnv +simplAuxBind :: SimplEnv -> InId -- Old binder; not a JoinId -> OutExpr -- Simplified RHS -> SimplM (SimplFloats, SimplEnv) --- A specialised variant of simplNonRec used when the RHS is already --- simplified, notably in knownCon. It uses case-binding where necessary. +-- A specialised variant of completeBindX used to construct non-recursive +-- auxiliary bindings, notably in knownCon. +-- +-- The binder comes from a case expression (case binder or alternative) +-- and so does not have rules, inline pragmas etc. -- -- Precondition: rhs satisfies the let-can-float invariant -simplNonRecX env bndr new_rhs - | assertPpr (not (isJoinId bndr)) (ppr bndr) $ +simplAuxBind env bndr new_rhs + | assertPpr (isId bndr && not (isJoinId bndr)) (ppr bndr) $ isDeadBinder bndr -- Not uncommon; e.g. case (a,b) of c { (p,q) -> p } = return (emptyFloats env, env) -- Here c is dead, and we avoid - -- creating the binding c = (a,b) - - | Coercion co <- new_rhs - = return (emptyFloats env, extendCvSubst env bndr co) + -- creating the binding c = (a,b) + -- The cases would be inlined unconditionally by completeBind: + -- but it seems not uncommon, and avoids faff to do it here + -- This is safe because it's only used for auxiliary bindings, which + -- have no NOLINE pragmas, nor RULEs | exprIsTrivial new_rhs -- Short-cut for let x = y in ... - -- This case would ultimately land in postInlineUnconditionally - -- but it seems not uncommon, and avoids a lot of faff to do it here - = return (emptyFloats env - , extendIdSubst env bndr (DoneEx new_rhs Nothing)) + = return ( emptyFloats env + , case new_rhs of + Coercion co -> extendCvSubst env bndr co + _ -> extendIdSubst env bndr (DoneEx new_rhs Nothing) ) | otherwise - = do { (env1, new_bndr) <- simplBinder env bndr - ; let is_strict = isStrictId new_bndr - -- isStrictId: use new_bndr because the InId bndr might not have - -- a fixed runtime representation, which isStrictId doesn't expect - -- c.f. Note [Dark corner with representation polymorphism] - - ; (rhs_floats, rhs1) <- prepareBinding env NotTopLevel NonRecursive is_strict - new_bndr (emptyFloats env) new_rhs - -- NB: it makes a surprisingly big difference (5% in compiler allocation - -- in T9630) to pass 'env' rather than 'env1'. It's fine to pass 'env', - -- because this is simplNonRecX, so bndr is not in scope in the RHS. - - ; (bind_float, env2) <- completeBind (env1 `setInScopeFromF` rhs_floats) - (BC_Let NotTopLevel NonRecursive) + = do { -- ANF-ise the RHS + let !occ_fs = getOccFS bndr + ; (anf_floats, rhs1) <- prepareRhs env NotTopLevel occ_fs new_rhs + ; unless (isEmptyLetFloats anf_floats) (tick LetFloatFromLet) + ; let rhs_floats = emptyFloats env `addLetFloats` anf_floats + + -- Simplify the binder and complete the binding + ; (env1, new_bndr) <- simplBinder (env `setInScopeFromF` rhs_floats) bndr + ; (bind_float, env2) <- completeBind env1 (BC_Let NotTopLevel NonRecursive) bndr new_bndr rhs1 - -- Must pass env1 to completeBind in case simplBinder had to clone, - -- and extended the substitution with [bndr :-> new_bndr] ; return (rhs_floats `addFloats` bind_float, env2) } @@ -761,49 +758,54 @@ prepareRhs :: HasDebugCallStack -- x = Just a -- See Note [prepareRhs] prepareRhs env top_lvl occ rhs0 - = do { (_is_exp, floats, rhs1) <- go 0 rhs0 - ; return (floats, rhs1) } + | is_expandable = anfise rhs0 + | otherwise = return (emptyLetFloats, rhs0) where - go :: Int -> OutExpr -> SimplM (Bool, LetFloats, OutExpr) - go n_val_args (Cast rhs co) - = do { (is_exp, floats, rhs') <- go n_val_args rhs - ; return (is_exp, floats, Cast rhs' co) } - go n_val_args (App fun (Type ty)) - = do { (is_exp, floats, rhs') <- go n_val_args fun - ; return (is_exp, floats, App rhs' (Type ty)) } - go n_val_args (App fun arg) - = do { (is_exp, floats1, fun') <- go (n_val_args+1) fun - ; if is_exp - then do { (floats2, arg') <- makeTrivial env top_lvl topDmd occ arg - ; return (True, floats1 `addLetFlts` floats2, App fun' arg') } - else return (False, emptyLetFloats, App fun arg) - } - go n_val_args (Var fun) - = return (is_exp, emptyLetFloats, Var fun) - where - is_exp = isExpandableApp fun n_val_args -- The fun a constructor or PAP - -- See Note [CONLIKE pragma] in GHC.Types.Basic - -- The definition of is_exp should match that in - -- 'GHC.Core.Opt.OccurAnal.occAnalApp' - - go n_val_args (Tick t rhs) + -- We can' use exprIsExpandable because the WHOLE POINT is that + -- we want to treat (K ) as expandable, because we are just + -- about "anfise" the expression. exprIsExpandable would + -- just say no! + is_expandable = go rhs0 0 + where + go (Var fun) n_val_args = isExpandableApp fun n_val_args + go (App fun arg) n_val_args + | isTypeArg arg = go fun n_val_args + | otherwise = go fun (n_val_args + 1) + go (Cast rhs _) n_val_args = go rhs n_val_args + go (Tick _ rhs) n_val_args = go rhs n_val_args + go _ _ = False + + anfise :: OutExpr -> SimplM (LetFloats, OutExpr) + anfise (Cast rhs co) + = do { (floats, rhs') <- anfise rhs + ; return (floats, Cast rhs' co) } + anfise (App fun (Type ty)) + = do { (floats, rhs') <- anfise fun + ; return (floats, App rhs' (Type ty)) } + anfise (App fun arg) + = do { (floats1, fun') <- anfise fun + ; (floats2, arg') <- makeTrivial env top_lvl topDmd occ arg + ; return (floats1 `addLetFlts` floats2, App fun' arg') } + anfise (Var fun) + = return (emptyLetFloats, Var fun) + + anfise (Tick t rhs) -- We want to be able to float bindings past this -- tick. Non-scoping ticks don't care. | tickishScoped t == NoScope - = do { (is_exp, floats, rhs') <- go n_val_args rhs - ; return (is_exp, floats, Tick t rhs') } + = do { (floats, rhs') <- anfise rhs + ; return (floats, Tick t rhs') } -- On the other hand, for scoping ticks we need to be able to -- copy them on the floats, which in turn is only allowed if -- we can obtain non-counting ticks. | (not (tickishCounts t) || tickishCanSplit t) - = do { (is_exp, floats, rhs') <- go n_val_args rhs + = do { (floats, rhs') <- anfise rhs ; let tickIt (id, expr) = (id, mkTick (mkNoCount t) expr) floats' = mapLetFloats floats tickIt - ; return (is_exp, floats', Tick t rhs') } + ; return (floats', Tick t rhs') } - go _ other - = return (False, emptyLetFloats, other) + anfise other = return (emptyLetFloats, other) makeTrivialArg :: HasDebugCallStack => SimplEnv -> ArgSpec -> SimplM (LetFloats, ArgSpec) makeTrivialArg env arg@(ValArg { as_arg = e, as_dmd = dmd }) @@ -1244,7 +1246,7 @@ simplExprF1 env (Let (NonRec bndr rhs) body) cont | otherwise = {-#SCC "simplNonRecE" #-} - simplNonRecE env False bndr (rhs, env) body cont + simplNonRecE env FromLet bndr (rhs, env) body cont {- Note [Avoiding space leaks in OutType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1505,8 +1507,9 @@ rebuild env expr cont StrictArg { sc_fun = fun, sc_cont = cont, sc_fun_ty = fun_ty } -> rebuildCall env (addValArgTo fun expr fun_ty ) cont - StrictBind { sc_bndr = b, sc_body = body, sc_env = se, sc_cont = cont } - -> completeBindX (se `setInScopeFromE` env) b expr body cont + StrictBind { sc_bndr = b, sc_body = body, sc_env = se + , sc_cont = cont, sc_from = from_what } + -> completeBindX (se `setInScopeFromE` env) from_what b expr body cont ApplyToTy { sc_arg_ty = ty, sc_cont = cont} -> rebuild env (App expr (Type ty)) cont @@ -1518,25 +1521,48 @@ rebuild env expr cont ; rebuild env (App expr arg') cont } completeBindX :: SimplEnv + -> FromWhat -> InId -> OutExpr -- Bind this Id to this (simplified) expression -- (the let-can-float invariant may not be satisfied) - -> InExpr -- In this lambda + -> InExpr -- In this body -> SimplCont -- Consumed by this continuation -> SimplM (SimplFloats, OutExpr) -completeBindX env bndr rhs body cont - | needsCaseBinding (idType bndr) rhs -- Enforcing the let-can-float-invariant - = do { (env1, bndr1) <- simplNonRecBndr env bndr - ; (floats, expr') <- simplLam env1 body cont +completeBindX env from_what bndr rhs body cont + | FromBeta arg_ty <- from_what + , needsCaseBinding arg_ty rhs -- Enforcing the let-can-float-invariant + = do { (env1, bndr1) <- simplNonRecBndr env bndr -- Lambda binders don't have rules + ; (floats, expr') <- simplNonRecBody env1 from_what body cont -- Do not float floats past the Case binder below ; let expr'' = wrapFloats floats expr' - ; let case_expr = Case rhs bndr1 (contResultType cont) [Alt DEFAULT [] expr''] + case_expr = Case rhs bndr1 (contResultType cont) [Alt DEFAULT [] expr''] ; return (emptyFloats env, case_expr) } - | otherwise - = do { (floats1, env') <- simplNonRecX env bndr rhs - ; (floats2, expr') <- simplLam env' body cont - ; return (floats1 `addFloats` floats2, expr') } + | otherwise -- Make a let-binding + = do { (env1, bndr1) <- simplNonRecBndr env bndr + ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) + + ; let is_strict = isStrictId bndr2 + -- isStrictId: use simplified binder because the InId bndr might not have + -- a fixed runtime representation, which isStrictId doesn't expect + -- c.f. Note [Dark corner with representation polymorphism] + + ; (rhs_floats, rhs1) <- prepareBinding env NotTopLevel NonRecursive is_strict + bndr2 (emptyFloats env) rhs + -- NB: it makes a surprisingly big difference (5% in compiler allocation + -- in T9630) to pass 'env' rather than 'env1'. It's fine to pass 'env', + -- because this is simplNonRecX, so bndr is not in scope in the RHS. + + ; (bind_float, env2) <- completeBind (env2 `setInScopeFromF` rhs_floats) + (BC_Let NotTopLevel NonRecursive) + bndr bndr2 rhs1 + -- Must pass env1 to completeBind in case simplBinder had to clone, + -- and extended the substitution with [bndr :-> new_bndr] + + -- Simplify the body + ; (body_floats, body') <- simplNonRecBody env2 from_what body cont + ; let all_floats = rhs_floats `addFloats` bind_float `addFloats` body_floats + ; return ( all_floats, body' ) } {- ************************************************************************ @@ -1674,6 +1700,14 @@ simplArg env dup_flag fun_ty arg_env arg ************************************************************************ -} +simplNonRecBody :: SimplEnv -> FromWhat + -> InExpr -> SimplCont + -> SimplM (SimplFloats, OutExpr) +simplNonRecBody env from_what body cont + = case from_what of + FromLet -> simplExprF env body cont + FromBeta {} -> simplLam env body cont + simplLam :: SimplEnv -> InExpr -> SimplCont -> SimplM (SimplFloats, OutExpr) @@ -1690,15 +1724,24 @@ simpl_lam env bndr body (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = cont }) -- Value beta-reduction simpl_lam env bndr body (ApplyToVal { sc_arg = arg, sc_env = arg_se - , sc_cont = cont, sc_dup = dup }) - | isSimplified dup -- Don't re-simplify if we've simplified it once - -- See Note [Avoiding exponential behaviour] + , sc_cont = cont, sc_dup = dup + , sc_hole_ty = fun_ty}) = do { tick (BetaReduction bndr) - ; completeBindX env bndr arg body cont } + ; let arg_ty = funArgTy fun_ty + ; if | isSimplified dup -- Don't re-simplify if we've simplified it once + -- Including don't preInlineUnconditionally + -- See Note [Avoiding exponential behaviour] + -> completeBindX env (FromBeta arg_ty) bndr arg body cont + + | Just env' <- preInlineUnconditionally env NotTopLevel bndr arg arg_se + , not (needsCaseBinding arg_ty arg) + -- Ok to test arg::InExpr in needsCaseBinding because + -- exprOkForSpeculation is stable under simplification + -> do { tick (PreInlineUnconditionally bndr) + ; simplLam env' body cont } - | otherwise -- See Note [Avoiding exponential behaviour] - = do { tick (BetaReduction bndr) - ; simplNonRecE env True bndr (arg, arg_se) body cont } + | otherwise + -> simplNonRecE env (FromBeta arg_ty) bndr (arg, arg_se) body cont } -- Discard a non-counting tick on a lambda. This may change the -- cost attribution slightly (moving the allocation of the @@ -1730,8 +1773,7 @@ simplLamBndrs env bndrs = mapAccumLM simplLamBndr env bndrs ------------------ simplNonRecE :: SimplEnv - -> Bool -- True <=> from a lambda - -- False <=> from a let + -> FromWhat -> InId -- The binder, always an Id -- Never a join point -> (InExpr, SimplEnv) -- Rhs of binding (or arg of lambda) @@ -1740,56 +1782,48 @@ simplNonRecE :: SimplEnv -> SimplM (SimplFloats, OutExpr) -- simplNonRecE is used for --- * non-top-level non-recursive non-join-point lets in expressions --- * beta reduction +-- * from=FromLet: a non-top-level non-recursive non-join-point let-expression +-- * from=FromBeta: a binding arising from a beta reduction -- --- simplNonRec env b (rhs, rhs_se) body k +-- simplNonRecE env b (rhs, rhs_se) body k -- = let env in -- cont< let b = rhs_se(rhs) in body > -- -- It deals with strict bindings, via the StrictBind continuation, -- which may abort the whole process. -- --- from_lam=False => the RHS satisfies the let-can-float invariant +-- from_what=FromLet => the RHS satisfies the let-can-float invariant -- Otherwise it may or may not satisfy it. -simplNonRecE env from_lam bndr (rhs, rhs_se) body cont - = assert (isId bndr && not (isJoinId bndr) ) $ - do { (env1, bndr1) <- simplNonRecBndr env bndr - ; let needs_case_binding = needsCaseBinding (idType bndr1) rhs - -- See Note [Dark corner with representation polymorphism] - -- If from_lam=False then needs_case_binding is False, - -- because the binding started as a let, which must - -- satisfy let-can-float - - ; if | from_lam && not needs_case_binding - -- If not from_lam we are coming from a (NonRec bndr rhs) binding - -- and preInlineUnconditionally has been done already; - -- no need to repeat it. But for lambdas we must be careful about - -- preInlineUndonditionally: consider (\(x:Int#). 3) (error "urk") - -- We must not drop the (error "urk"). - , Just env' <- preInlineUnconditionally env NotTopLevel bndr rhs rhs_se - -> do { tick (PreInlineUnconditionally bndr) - ; -- pprTrace "preInlineUncond" (ppr bndr <+> ppr rhs) $ - simplLam env' body cont } - - -- Deal with strict bindings - | isStrictId bndr1 && seCaseCase env - || from_lam && needs_case_binding - -- The important bit here is needs_case_binds; but no need to - -- test it if from_lam is False because then needs_case_binding is False too - -- NB: either way, the RHS may or may not satisfy let-can-float - -- but that's ok for StrictBind. - -> simplExprF (rhs_se `setInScopeFromE` env) rhs - (StrictBind { sc_bndr = bndr, sc_body = body - , sc_env = env, sc_cont = cont, sc_dup = NoDup }) - - -- Deal with lazy bindings - | otherwise - -> do { (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) - ; (floats1, env3) <- simplLazyBind env2 NotTopLevel NonRecursive bndr bndr2 rhs rhs_se - ; (floats2, expr') <- simplLam env3 body cont - ; return (floats1 `addFloats` floats2, expr') } } +simplNonRecE env from_what bndr (rhs, rhs_se) body cont + | assert (isId bndr && not (isJoinId bndr) ) $ + is_strict_bind + = -- Evaluate RHS strictly + simplExprF (rhs_se `setInScopeFromE` env) rhs + (StrictBind { sc_bndr = bndr, sc_body = body, sc_from = from_what + , sc_env = env, sc_cont = cont, sc_dup = NoDup }) + + | otherwise -- Evaluate RHS lazily + = do { (env1, bndr1) <- simplNonRecBndr env bndr + ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) + ; (floats1, env3) <- simplLazyBind env2 NotTopLevel NonRecursive + bndr bndr2 rhs rhs_se + ; (floats2, expr') <- simplNonRecBody env3 from_what body cont + ; return (floats1 `addFloats` floats2, expr') } + + where + is_strict_bind = case from_what of + FromBeta arg_ty | isUnliftedType arg_ty -> True + -- If we are coming from a beta-reduction (FromBeta) we must + -- establish the let-can-float invariant, so go via StrictBind + -- If not, the invariant holds already, and it's optional. + -- Using arg_ty: see Note [Dark corner with representation polymorphism] + -- e.g (\r \(a::TYPE r) \(x::a). blah) @LiftedRep @Int arg + -- When we come to `x=arg` we myst choose lazy/strict correctly + -- It's wrong to err in either directly + + _ -> seCaseCase env && isStrUsedDmd (idDemandInfo bndr) + ------------------ simplRecE :: SimplEnv @@ -1835,7 +1869,7 @@ Note [Avoiding exponential behaviour] One way in which we can get exponential behaviour is if we simplify a big expression, and then re-simplify it -- and then this happens in a deeply-nested way. So we must be jolly careful about re-simplifying -an expression. That is why simplNonRecX does not try +an expression (#13379). That is why simplNonRecX does not try preInlineUnconditionally (unlike simplNonRecE). Example: @@ -2618,15 +2652,10 @@ Is this inefficient? Not really: we are about to walk over the result of the rule firing to simplify it, so occurrence analysis is at most a constant factor. -Possible improvement: occ-anal the rules when putting them in the -database; and in the simplifier just occ-anal the OutExpr arguments. -But that's more complicated and the rule RHS is usually tiny; so I'm -just doing the simple thing. - -Historical note: previously we did occ-anal the rules in Rule.hs, -but failed to occ-anal the OutExpr arguments, which led to the -nasty performance problem described above. - +Note, however, that the rule RHS is /already/ occ-analysed; see +Note [OccInfo in unfoldings and rules] in GHC.Core. There is something +unsatisfactory about doing it twice; but the rule RHS is usually very +small, and this is simple. Note [Optimising tagToEnum#] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2930,7 +2959,7 @@ rebuildCase env scrut case_bndr alts cont where simple_rhs env wfloats case_bndr_rhs bs rhs = assert (null bs) $ - do { (floats1, env') <- simplNonRecX env case_bndr case_bndr_rhs + do { (floats1, env') <- simplAuxBind env case_bndr case_bndr_rhs -- scrut is a constructor application, -- hence satisfies let-can-float invariant ; (floats2, expr') <- simplExprF env' rhs cont @@ -2997,7 +3026,7 @@ rebuildCase env scrut case_bndr alts@[Alt _ bndrs rhs] cont | all_dead_bndrs , doCaseToLet scrut case_bndr = do { tick (CaseElim case_bndr) - ; (floats1, env') <- simplNonRecX env case_bndr scrut + ; (floats1, env') <- simplAuxBind env case_bndr scrut ; (floats2, expr') <- simplExprF env' rhs cont ; return (floats1 `addFloats` floats2, expr') } @@ -3483,12 +3512,11 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont bind_args env' (b:bs') (arg : args) = assert (isId b) $ do { let b' = zap_occ b - -- Note that the binder might be "dead", because it doesn't - -- occur in the RHS; and simplNonRecX may therefore discard - -- it via postInlineUnconditionally. + -- zap_occ: the binder might be "dead", because it doesn't + -- occur in the RHS; and simplAuxBind may therefore discard it. -- Nevertheless we must keep it if the case-binder is alive, -- because it may be used in the con_app. See Note [knownCon occ info] - ; (floats1, env2) <- simplNonRecX env' b' arg -- arg satisfies let-can-float invariant + ; (floats1, env2) <- simplAuxBind env' b' arg -- arg satisfies let-can-float invariant ; (floats2, env3) <- bind_args env2 bs' args ; return (floats1 `addFloats` floats2, env3) } @@ -3514,7 +3542,7 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont ; let con_app = Var (dataConWorkId dc) `mkTyApps` dc_ty_args `mkApps` dc_args - ; simplNonRecX env bndr con_app } + ; simplAuxBind env bndr con_app } ------------------- missingAlt :: SimplEnv -> Id -> [InAlt] -> SimplCont @@ -3621,15 +3649,15 @@ mkDupableContWithDmds env dmds (TickIt t cont) ; return (floats, TickIt t cont') } mkDupableContWithDmds env _ - (StrictBind { sc_bndr = bndr, sc_body = body + (StrictBind { sc_bndr = bndr, sc_body = body, sc_from = from_what , sc_env = se, sc_cont = cont}) -- See Note [Duplicating StrictBind] -- K[ let x = <> in b ] --> join j x = K[ b ] -- j <> = do { let sb_env = se `setInScopeFromE` env ; (sb_env1, bndr') <- simplBinder sb_env bndr - ; (floats1, join_inner) <- simplLam sb_env1 body cont - -- No need to use mkDupableCont before simplLam; we + ; (floats1, join_inner) <- simplNonRecBody sb_env1 from_what body cont + -- No need to use mkDupableCont before simplNonRecBody; we -- use cont once here, and then share the result if necessary ; let join_body = wrapFloats floats1 join_inner @@ -3757,6 +3785,7 @@ mkDupableStrictBind env arg_bndr join_rhs res_ty , StrictBind { sc_bndr = arg_bndr , sc_body = join_rhs , sc_env = zapSubstEnv env + , sc_from = FromLet -- See Note [StaticEnv invariant] in GHC.Core.Opt.Simplify.Utils , sc_dup = OkToDup , sc_cont = mkBoringStop res_ty } ) @@ -4430,7 +4459,9 @@ simplRules env mb_new_id rules bind_cxt ; return (rule { ru_bndrs = bndrs' , ru_fn = fn_name' , ru_args = args' - , ru_rhs = rhs' }) } + , ru_rhs = occurAnalyseExpr rhs' }) } + -- Remember to occ-analyse, to drop dead code. + -- See Note [OccInfo in unfoldings and rules] in GHC.Core {- Note [Simplifying the RHS of a RULE] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -21,7 +21,7 @@ module GHC.Core.Opt.Simplify.Utils ( BindContext(..), bindContextLevel, -- The continuation type - SimplCont(..), DupFlag(..), StaticEnv, + SimplCont(..), DupFlag(..), FromWhat(..), StaticEnv, isSimplified, contIsStop, contIsDupable, contResultType, contHoleType, contHoleScaling, contIsTrivial, contArgs, contIsRhs, @@ -192,6 +192,7 @@ data SimplCont -- or, equivalently, = K[ (\x.b) e ] { sc_dup :: DupFlag -- See Note [DupFlag invariants] , sc_bndr :: InId + , sc_from :: FromWhat , sc_body :: InExpr , sc_env :: StaticEnv -- See Note [StaticEnv invariant] , sc_cont :: SimplCont } @@ -213,6 +214,8 @@ data SimplCont type StaticEnv = SimplEnv -- Just the static part is relevant +data FromWhat = FromLet | FromBeta OutType + -- See Note [DupFlag invariants] data DupFlag = NoDup -- Unsimplified, might be big | Simplified -- Simplified ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -63,6 +63,7 @@ import GHC.Core.Tidy ( tidyRules ) import GHC.Core.Map.Expr ( eqCoreExpr ) import GHC.Core.Opt.Arity( etaExpandToJoinPointRule ) import GHC.Core.Make ( mkCoreLams ) +import GHC.Core.Opt.OccurAnal( occurAnalyseExpr ) import GHC.Tc.Utils.TcType ( tcSplitTyConApp_maybe ) import GHC.Builtin.Types ( anyTypeOfKind ) @@ -189,13 +190,18 @@ mkRule :: Module -> Bool -> Bool -> RuleName -> Activation -- ^ Used to make 'CoreRule' for an 'Id' defined in the module being -- compiled. See also 'GHC.Core.CoreRule' mkRule this_mod is_auto is_local name act fn bndrs args rhs - = Rule { ru_name = name, ru_fn = fn, ru_act = act, - ru_bndrs = bndrs, ru_args = args, - ru_rhs = rhs, - ru_rough = roughTopNames args, - ru_origin = this_mod, - ru_orphan = orph, - ru_auto = is_auto, ru_local = is_local } + = Rule { ru_name = name + , ru_act = act + , ru_fn = fn + , ru_bndrs = bndrs + , ru_args = args + , ru_rhs = occurAnalyseExpr rhs + -- See Note [OccInfo in unfoldings and rules] + , ru_rough = roughTopNames args + , ru_origin = this_mod + , ru_orphan = orph + , ru_auto = is_auto + , ru_local = is_local } where -- Compute orphanhood. See Note [Orphans] in GHC.Core.InstEnv -- A rule is an orphan only if none of the variables ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -513,8 +513,8 @@ bindNonRec bndr rhs body -- | Tests whether we have to use a @case@ rather than @let@ binding for this -- expression as per the invariants of 'CoreExpr': see "GHC.Core#let_can_float_invariant" needsCaseBinding :: Type -> CoreExpr -> Bool -needsCaseBinding ty rhs = - mightBeUnliftedType ty && not (exprOkForSpeculation rhs) +needsCaseBinding ty rhs + = mightBeUnliftedType ty && not (exprOkForSpeculation rhs) -- Make a case expression instead of a let -- These can arise either from the desugarer, -- or from beta reductions: (\x.e) (x +# y) ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -723,12 +723,14 @@ setIdCprSig id sig = modifyIdInfo (\info -> setCprSigInfo info sig) id zapIdDmdSig :: Id -> Id zapIdDmdSig id = modifyIdInfo (`setDmdSigInfo` nopSig) id --- | This predicate says whether the 'Id' has a strict demand placed on it or --- has a type such that it can always be evaluated strictly (i.e an --- unlifted type, as of GHC 7.6). We need to --- check separately whether the 'Id' has a so-called \"strict type\" because if --- the demand for the given @id@ hasn't been computed yet but @id@ has a strict --- type, we still want @isStrictId id@ to be @True at . +-- | `isStrictId` says whether either +-- (a) the 'Id' has a strict demand placed on it or +-- (b) definitely has a \"strict type\", such that it can always be +-- evaluated strictly (i.e an unlifted type) +-- We need to check (b) as well as (a), because when the demand for the +-- given `id` hasn't been computed yet but `id` has a strict +-- type, we still want `isStrictId id` to be `True`. +-- Returns False if the type is levity polymorphic; False is always safe. isStrictId :: Id -> Bool isStrictId id | assertPpr (isId id) (text "isStrictId: not an id: " <+> ppr id) $ ===================================== testsuite/tests/simplCore/should_compile/T22761.hs ===================================== @@ -0,0 +1,40 @@ +module T22761 where + +import T22761a + +newtype Mod m = Mod m deriving Num + +gcdExt :: Integer -> (Integer, Integer) +gcdExt x = go 0 x + where + go !_ 0 = (1, 1) + go r _ = go r r + +pow :: (Num m) => Mod m -> Mod m +pow x = x*x*x +{-# NOINLINE [1] pow #-} +{-# RULES +"powMod/3/Int" forall x. pow x = x*x*x +#-} + + +-- GHC puts `boo1` after `wom1` (since they don't appear connected) +-- Then { wom1 = foo True } rewrites to { wom1 = boo False } +-- so we need to do glomming. And that triggers the bug +-- in the RULE for `pow`! +-- +-- wom2/boo2 are there to still elicit the bug if +-- GHC reverses its default ordering + +{-# RULES +"wombat1" foo True = boo1 False +#-} + +wom1 = foo True +boo1 x = x + +{-# RULES +"wombat2" foo True = boo2 False +#-} +boo2 x = x +wom2 = foo True ===================================== testsuite/tests/simplCore/should_compile/T22761a.hs ===================================== @@ -0,0 +1,4 @@ +module T22761a where + +{-# NOINLINE [0] foo #-} +foo x = x ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -471,5 +471,6 @@ test('T22611', [when(wordsize(32), skip), grep_errmsg(r'\$salterF') ], compile, test('T22715_2', normal, multimod_compile, ['T22715_2', '-v0 -O -fspecialise-aggressively']) test('T22802', normal, compile, ['-O']) test('T15205', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) +test('T22761', normal, multimod_compile, ['T22761', '-O2 -v0']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e45eb82830d6de4d09abb548e190be980dd001b4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e45eb82830d6de4d09abb548e190be980dd001b4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 10 11:52:31 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 10 Feb 2023 06:52:31 -0500 Subject: [Git][ghc/ghc][master] Detect the `mold` linker Message-ID: <63e62fff34d74_2b039a1fb8a16869865d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 2 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/SysTools/Info.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4939,6 +4939,7 @@ needSourceNotes dflags = debugLevel dflags > 0 -- LinkerInfo contains any extra options needed by the system linker. data LinkerInfo = GnuLD [Option] + | Mold [Option] | GnuGold [Option] | LlvmLLD [Option] | DarwinLD [Option] ===================================== compiler/GHC/SysTools/Info.hs ===================================== @@ -70,6 +70,7 @@ The flag is only needed on ELF systems. On Windows (PE) and Mac OS X neededLinkArgs :: LinkerInfo -> [Option] neededLinkArgs (GnuLD o) = o +neededLinkArgs (Mold o) = o neededLinkArgs (GnuGold o) = o neededLinkArgs (LlvmLLD o) = o neededLinkArgs (DarwinLD o) = o @@ -106,6 +107,10 @@ getLinkerInfo' logger dflags = do -- see Note [ELF needed shared libs] "-Wl,--no-as-needed"]) + | any ("mold" `isPrefixOf`) stdo = + return (Mold $ map Option [ --see Note [ELF needed shared libs] + "-Wl,--no-as-needed"]) + | any ("GNU gold" `isPrefixOf`) stdo = -- GNU gold only needs --no-as-needed. #10110. -- ELF specific flag, see Note [ELF needed shared libs] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/11e0cacb039cee4198cd6043ab0d9e08332d4d8a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/11e0cacb039cee4198cd6043ab0d9e08332d4d8a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 10 12:23:25 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 10 Feb 2023 07:23:25 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Refactor the simplifier a bit to fix #22761 Message-ID: <63e6373d16f38_2b039a527107083b5@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 36607f25 by parsonsmatt at 2023-02-10T07:23:00-05:00 Add Lift instance for Fixed - - - - - c78f4945 by Sylvain Henry at 2023-02-10T07:23:03-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - c4faa59a by Zubin Duggal at 2023-02-10T07:23:04-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 19 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Unit/Module/ModIface.hs - libraries/base/tests/all.T - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - libraries/template-haskell/changelog.md - testsuite/driver/testlib.py - + testsuite/tests/simplCore/should_compile/T22761.hs - + testsuite/tests/simplCore/should_compile/T22761a.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -1300,16 +1300,19 @@ data Unfolding df_args :: [CoreExpr] -- Args of the data con: types, superclasses and methods, } -- in positional order - | CoreUnfolding { -- An unfolding for an Id with no pragma, - -- or perhaps a NOINLINE pragma - -- (For NOINLINE, the phase, if any, is in the - -- InlinePragInfo for this Id.) - uf_tmpl :: CoreExpr, -- Template; occurrence info is correct - uf_src :: UnfoldingSource, -- Where the unfolding came from - uf_is_top :: Bool, -- True <=> top level binding - uf_cache :: UnfoldingCache, -- Cache of flags computable from the expr - -- See Note [Tying the 'CoreUnfolding' knot] - uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template. + | CoreUnfolding { -- An unfolding for an Id with no pragma, + -- or perhaps a NOINLINE pragma + -- (For NOINLINE, the phase, if any, is in the + -- InlinePragInfo for this Id.) + uf_tmpl :: CoreExpr, -- The unfolding itself (aka "template") + -- Always occ-analysed; + -- See Note [OccInfo in unfoldings and rules] + + uf_src :: UnfoldingSource, -- Where the unfolding came from + uf_is_top :: Bool, -- True <=> top level binding + uf_cache :: UnfoldingCache, -- Cache of flags computable from the expr + -- See Note [Tying the 'CoreUnfolding' knot] + uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template. } -- ^ An unfolding with redundant cached information. Parameters: -- @@ -1637,14 +1640,37 @@ change was requested by Roman, but it seems to make sense. Note [OccInfo in unfoldings and rules] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In unfoldings and rules, we guarantee that the template is occ-analysed, -so that the occurrence info on the binders is correct. This is important, -because the Simplifier does not re-analyse the template when using it. If -the occurrence info is wrong - - We may get more simplifier iterations than necessary, because - once-occ info isn't there - - More seriously, we may get an infinite loop if there's a Rec - without a loop breaker marked +In unfoldings and rules, we guarantee that the template is occ-analysed, so +that the occurrence info on the binders is correct. That way, when the +Simplifier inlines an unfolding, it doesn't need to occ-analysis it first. +(The Simplifier is designed to simplify occ-analysed expressions.) + +Given this decision it's vital that we do *always* do it. + +* If we don't, we may get more simplifier iterations than necessary, + because once-occ info isn't there + +* More seriously, we may get an infinite loop if there's a Rec without a + loop breaker marked. + +* Or we may get code that mentions variables not in scope: #22761 + e.g. Suppose we have a stable unfolding : \y. let z = p+1 in 3 + Then the pre-simplifier occ-anal will occ-anal the unfolding + (redundantly perhaps, but we need its free vars); this will not report + the use of `p`; so p's binding will be discarded, and yet `p` is still + mentioned. + + Better to occ-anal the unfolding at birth, which will drop the + z-binding as dead code. (Remember, it's the occurrence analyser that + drops dead code.) + +* Another example is #8892: + \x -> letrec { f = ...g...; g* = f } in body + where g* is (for some strange reason) the loop breaker. If we don't + occ-anal it when reading it in, we won't mark g as a loop breaker, and we + may inline g entirely in body, dropping its binding, and leaving the + occurrence in f out of scope. This happened in #8892, where the unfolding + in question was a DFun unfolding. ************************************************************************ ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -3088,8 +3088,15 @@ etaExpandToJoinPointRule join_arity rule@(Rule { ru_bndrs = bndrs, ru_rhs = rhs | need_args < 0 = pprPanic "etaExpandToJoinPointRule" (ppr join_arity $$ ppr rule) | otherwise - = rule { ru_bndrs = bndrs ++ new_bndrs, ru_args = args ++ new_args - , ru_rhs = new_rhs } + = rule { ru_bndrs = bndrs ++ new_bndrs + , ru_args = args ++ new_args + , ru_rhs = new_rhs } + -- new_rhs really ought to be occ-analysed (see GHC.Core Note + -- [OccInfo in unfoldings and rules]), but it makes a module loop to + -- do so; it doesn't happen often; and it doesn't really matter if + -- the outer binders have bogus occurrence info; and new_rhs won't + -- have dead code if rhs didn't. + where need_args = join_arity - length args (new_bndrs, new_rhs) = etaBodyForJoinPoint need_args rhs ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -2165,6 +2165,17 @@ So we have a fast-path that keeps the old tree if the occ_bs_env is empty. This just saves a bit of allocation and reconstruction; not a big deal. +This fast path exposes a tricky cornder, though (#22761). Supose we have + Unfolding = \x. let y = foo in x+1 +which includes a dead binding for `y`. In occAnalUnfolding we occ-anal +the unfolding and produce /no/ occurrences of `foo` (since `y` is +dead). But if we discard the occ-analysed syntax tree (which we do on +our fast path), and use the old one, we still /have/ an occurrence of +`foo` -- and that can lead to out-of-scope variables (#22761). + +Solution: always keep occ-analysed trees in unfoldings and rules, so they +have no dead code. See Note [OccInfo in unfoldings and rules] in GHC.Core. + Note [Cascading inlines] ~~~~~~~~~~~~~~~~~~~~~~~~ By default we use an rhsCtxt for the RHS of a binding. This tells the ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -1065,7 +1065,7 @@ subst_id_bndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) -- See Note [Bangs in the Simplifier] !id1 = uniqAway in_scope old_id !id2 = substIdType env id1 - !id3 = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding + !id3 = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding -- and fragile OccInfo !new_id = adjust_type id3 ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -319,14 +319,14 @@ simplLazyBind :: SimplEnv -> TopLevelFlag -> RecFlag -> InId -> OutId -- Binder, both pre-and post simpl -- Not a JoinId - -- The OutId has IdInfo, except arity, unfolding + -- The OutId has IdInfo (notably RULES), + -- except arity, unfolding -- Ids only, no TyVars -> InExpr -> SimplEnv -- The RHS and its environment -> SimplM (SimplFloats, SimplEnv) -- Precondition: the OutId is already in the InScopeSet of the incoming 'env' -- Precondition: not a JoinId -- Precondition: rhs obeys the let-can-float invariant --- NOT used for JoinIds simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se = assert (isId bndr ) assertPpr (not (isJoinId bndr)) (ppr bndr) $ @@ -398,48 +398,45 @@ simplJoinBind env is_rec cont old_bndr new_bndr rhs rhs_se ; completeBind env (BC_Join is_rec cont) old_bndr new_bndr rhs' } -------------------------- -simplNonRecX :: SimplEnv +simplAuxBind :: SimplEnv -> InId -- Old binder; not a JoinId -> OutExpr -- Simplified RHS -> SimplM (SimplFloats, SimplEnv) --- A specialised variant of simplNonRec used when the RHS is already --- simplified, notably in knownCon. It uses case-binding where necessary. +-- A specialised variant of completeBindX used to construct non-recursive +-- auxiliary bindings, notably in knownCon. +-- +-- The binder comes from a case expression (case binder or alternative) +-- and so does not have rules, inline pragmas etc. -- -- Precondition: rhs satisfies the let-can-float invariant -simplNonRecX env bndr new_rhs - | assertPpr (not (isJoinId bndr)) (ppr bndr) $ +simplAuxBind env bndr new_rhs + | assertPpr (isId bndr && not (isJoinId bndr)) (ppr bndr) $ isDeadBinder bndr -- Not uncommon; e.g. case (a,b) of c { (p,q) -> p } = return (emptyFloats env, env) -- Here c is dead, and we avoid - -- creating the binding c = (a,b) - - | Coercion co <- new_rhs - = return (emptyFloats env, extendCvSubst env bndr co) + -- creating the binding c = (a,b) + -- The cases would be inlined unconditionally by completeBind: + -- but it seems not uncommon, and avoids faff to do it here + -- This is safe because it's only used for auxiliary bindings, which + -- have no NOLINE pragmas, nor RULEs | exprIsTrivial new_rhs -- Short-cut for let x = y in ... - -- This case would ultimately land in postInlineUnconditionally - -- but it seems not uncommon, and avoids a lot of faff to do it here - = return (emptyFloats env - , extendIdSubst env bndr (DoneEx new_rhs Nothing)) + = return ( emptyFloats env + , case new_rhs of + Coercion co -> extendCvSubst env bndr co + _ -> extendIdSubst env bndr (DoneEx new_rhs Nothing) ) | otherwise - = do { (env1, new_bndr) <- simplBinder env bndr - ; let is_strict = isStrictId new_bndr - -- isStrictId: use new_bndr because the InId bndr might not have - -- a fixed runtime representation, which isStrictId doesn't expect - -- c.f. Note [Dark corner with representation polymorphism] - - ; (rhs_floats, rhs1) <- prepareBinding env NotTopLevel NonRecursive is_strict - new_bndr (emptyFloats env) new_rhs - -- NB: it makes a surprisingly big difference (5% in compiler allocation - -- in T9630) to pass 'env' rather than 'env1'. It's fine to pass 'env', - -- because this is simplNonRecX, so bndr is not in scope in the RHS. - - ; (bind_float, env2) <- completeBind (env1 `setInScopeFromF` rhs_floats) - (BC_Let NotTopLevel NonRecursive) + = do { -- ANF-ise the RHS + let !occ_fs = getOccFS bndr + ; (anf_floats, rhs1) <- prepareRhs env NotTopLevel occ_fs new_rhs + ; unless (isEmptyLetFloats anf_floats) (tick LetFloatFromLet) + ; let rhs_floats = emptyFloats env `addLetFloats` anf_floats + + -- Simplify the binder and complete the binding + ; (env1, new_bndr) <- simplBinder (env `setInScopeFromF` rhs_floats) bndr + ; (bind_float, env2) <- completeBind env1 (BC_Let NotTopLevel NonRecursive) bndr new_bndr rhs1 - -- Must pass env1 to completeBind in case simplBinder had to clone, - -- and extended the substitution with [bndr :-> new_bndr] ; return (rhs_floats `addFloats` bind_float, env2) } @@ -761,49 +758,54 @@ prepareRhs :: HasDebugCallStack -- x = Just a -- See Note [prepareRhs] prepareRhs env top_lvl occ rhs0 - = do { (_is_exp, floats, rhs1) <- go 0 rhs0 - ; return (floats, rhs1) } + | is_expandable = anfise rhs0 + | otherwise = return (emptyLetFloats, rhs0) where - go :: Int -> OutExpr -> SimplM (Bool, LetFloats, OutExpr) - go n_val_args (Cast rhs co) - = do { (is_exp, floats, rhs') <- go n_val_args rhs - ; return (is_exp, floats, Cast rhs' co) } - go n_val_args (App fun (Type ty)) - = do { (is_exp, floats, rhs') <- go n_val_args fun - ; return (is_exp, floats, App rhs' (Type ty)) } - go n_val_args (App fun arg) - = do { (is_exp, floats1, fun') <- go (n_val_args+1) fun - ; if is_exp - then do { (floats2, arg') <- makeTrivial env top_lvl topDmd occ arg - ; return (True, floats1 `addLetFlts` floats2, App fun' arg') } - else return (False, emptyLetFloats, App fun arg) - } - go n_val_args (Var fun) - = return (is_exp, emptyLetFloats, Var fun) - where - is_exp = isExpandableApp fun n_val_args -- The fun a constructor or PAP - -- See Note [CONLIKE pragma] in GHC.Types.Basic - -- The definition of is_exp should match that in - -- 'GHC.Core.Opt.OccurAnal.occAnalApp' - - go n_val_args (Tick t rhs) + -- We can' use exprIsExpandable because the WHOLE POINT is that + -- we want to treat (K ) as expandable, because we are just + -- about "anfise" the expression. exprIsExpandable would + -- just say no! + is_expandable = go rhs0 0 + where + go (Var fun) n_val_args = isExpandableApp fun n_val_args + go (App fun arg) n_val_args + | isTypeArg arg = go fun n_val_args + | otherwise = go fun (n_val_args + 1) + go (Cast rhs _) n_val_args = go rhs n_val_args + go (Tick _ rhs) n_val_args = go rhs n_val_args + go _ _ = False + + anfise :: OutExpr -> SimplM (LetFloats, OutExpr) + anfise (Cast rhs co) + = do { (floats, rhs') <- anfise rhs + ; return (floats, Cast rhs' co) } + anfise (App fun (Type ty)) + = do { (floats, rhs') <- anfise fun + ; return (floats, App rhs' (Type ty)) } + anfise (App fun arg) + = do { (floats1, fun') <- anfise fun + ; (floats2, arg') <- makeTrivial env top_lvl topDmd occ arg + ; return (floats1 `addLetFlts` floats2, App fun' arg') } + anfise (Var fun) + = return (emptyLetFloats, Var fun) + + anfise (Tick t rhs) -- We want to be able to float bindings past this -- tick. Non-scoping ticks don't care. | tickishScoped t == NoScope - = do { (is_exp, floats, rhs') <- go n_val_args rhs - ; return (is_exp, floats, Tick t rhs') } + = do { (floats, rhs') <- anfise rhs + ; return (floats, Tick t rhs') } -- On the other hand, for scoping ticks we need to be able to -- copy them on the floats, which in turn is only allowed if -- we can obtain non-counting ticks. | (not (tickishCounts t) || tickishCanSplit t) - = do { (is_exp, floats, rhs') <- go n_val_args rhs + = do { (floats, rhs') <- anfise rhs ; let tickIt (id, expr) = (id, mkTick (mkNoCount t) expr) floats' = mapLetFloats floats tickIt - ; return (is_exp, floats', Tick t rhs') } + ; return (floats', Tick t rhs') } - go _ other - = return (False, emptyLetFloats, other) + anfise other = return (emptyLetFloats, other) makeTrivialArg :: HasDebugCallStack => SimplEnv -> ArgSpec -> SimplM (LetFloats, ArgSpec) makeTrivialArg env arg@(ValArg { as_arg = e, as_dmd = dmd }) @@ -1244,7 +1246,7 @@ simplExprF1 env (Let (NonRec bndr rhs) body) cont | otherwise = {-#SCC "simplNonRecE" #-} - simplNonRecE env False bndr (rhs, env) body cont + simplNonRecE env FromLet bndr (rhs, env) body cont {- Note [Avoiding space leaks in OutType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1505,8 +1507,9 @@ rebuild env expr cont StrictArg { sc_fun = fun, sc_cont = cont, sc_fun_ty = fun_ty } -> rebuildCall env (addValArgTo fun expr fun_ty ) cont - StrictBind { sc_bndr = b, sc_body = body, sc_env = se, sc_cont = cont } - -> completeBindX (se `setInScopeFromE` env) b expr body cont + StrictBind { sc_bndr = b, sc_body = body, sc_env = se + , sc_cont = cont, sc_from = from_what } + -> completeBindX (se `setInScopeFromE` env) from_what b expr body cont ApplyToTy { sc_arg_ty = ty, sc_cont = cont} -> rebuild env (App expr (Type ty)) cont @@ -1518,25 +1521,48 @@ rebuild env expr cont ; rebuild env (App expr arg') cont } completeBindX :: SimplEnv + -> FromWhat -> InId -> OutExpr -- Bind this Id to this (simplified) expression -- (the let-can-float invariant may not be satisfied) - -> InExpr -- In this lambda + -> InExpr -- In this body -> SimplCont -- Consumed by this continuation -> SimplM (SimplFloats, OutExpr) -completeBindX env bndr rhs body cont - | needsCaseBinding (idType bndr) rhs -- Enforcing the let-can-float-invariant - = do { (env1, bndr1) <- simplNonRecBndr env bndr - ; (floats, expr') <- simplLam env1 body cont +completeBindX env from_what bndr rhs body cont + | FromBeta arg_ty <- from_what + , needsCaseBinding arg_ty rhs -- Enforcing the let-can-float-invariant + = do { (env1, bndr1) <- simplNonRecBndr env bndr -- Lambda binders don't have rules + ; (floats, expr') <- simplNonRecBody env1 from_what body cont -- Do not float floats past the Case binder below ; let expr'' = wrapFloats floats expr' - ; let case_expr = Case rhs bndr1 (contResultType cont) [Alt DEFAULT [] expr''] + case_expr = Case rhs bndr1 (contResultType cont) [Alt DEFAULT [] expr''] ; return (emptyFloats env, case_expr) } - | otherwise - = do { (floats1, env') <- simplNonRecX env bndr rhs - ; (floats2, expr') <- simplLam env' body cont - ; return (floats1 `addFloats` floats2, expr') } + | otherwise -- Make a let-binding + = do { (env1, bndr1) <- simplNonRecBndr env bndr + ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) + + ; let is_strict = isStrictId bndr2 + -- isStrictId: use simplified binder because the InId bndr might not have + -- a fixed runtime representation, which isStrictId doesn't expect + -- c.f. Note [Dark corner with representation polymorphism] + + ; (rhs_floats, rhs1) <- prepareBinding env NotTopLevel NonRecursive is_strict + bndr2 (emptyFloats env) rhs + -- NB: it makes a surprisingly big difference (5% in compiler allocation + -- in T9630) to pass 'env' rather than 'env1'. It's fine to pass 'env', + -- because this is simplNonRecX, so bndr is not in scope in the RHS. + + ; (bind_float, env2) <- completeBind (env2 `setInScopeFromF` rhs_floats) + (BC_Let NotTopLevel NonRecursive) + bndr bndr2 rhs1 + -- Must pass env1 to completeBind in case simplBinder had to clone, + -- and extended the substitution with [bndr :-> new_bndr] + + -- Simplify the body + ; (body_floats, body') <- simplNonRecBody env2 from_what body cont + ; let all_floats = rhs_floats `addFloats` bind_float `addFloats` body_floats + ; return ( all_floats, body' ) } {- ************************************************************************ @@ -1674,6 +1700,14 @@ simplArg env dup_flag fun_ty arg_env arg ************************************************************************ -} +simplNonRecBody :: SimplEnv -> FromWhat + -> InExpr -> SimplCont + -> SimplM (SimplFloats, OutExpr) +simplNonRecBody env from_what body cont + = case from_what of + FromLet -> simplExprF env body cont + FromBeta {} -> simplLam env body cont + simplLam :: SimplEnv -> InExpr -> SimplCont -> SimplM (SimplFloats, OutExpr) @@ -1690,15 +1724,24 @@ simpl_lam env bndr body (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = cont }) -- Value beta-reduction simpl_lam env bndr body (ApplyToVal { sc_arg = arg, sc_env = arg_se - , sc_cont = cont, sc_dup = dup }) - | isSimplified dup -- Don't re-simplify if we've simplified it once - -- See Note [Avoiding exponential behaviour] + , sc_cont = cont, sc_dup = dup + , sc_hole_ty = fun_ty}) = do { tick (BetaReduction bndr) - ; completeBindX env bndr arg body cont } + ; let arg_ty = funArgTy fun_ty + ; if | isSimplified dup -- Don't re-simplify if we've simplified it once + -- Including don't preInlineUnconditionally + -- See Note [Avoiding exponential behaviour] + -> completeBindX env (FromBeta arg_ty) bndr arg body cont + + | Just env' <- preInlineUnconditionally env NotTopLevel bndr arg arg_se + , not (needsCaseBinding arg_ty arg) + -- Ok to test arg::InExpr in needsCaseBinding because + -- exprOkForSpeculation is stable under simplification + -> do { tick (PreInlineUnconditionally bndr) + ; simplLam env' body cont } - | otherwise -- See Note [Avoiding exponential behaviour] - = do { tick (BetaReduction bndr) - ; simplNonRecE env True bndr (arg, arg_se) body cont } + | otherwise + -> simplNonRecE env (FromBeta arg_ty) bndr (arg, arg_se) body cont } -- Discard a non-counting tick on a lambda. This may change the -- cost attribution slightly (moving the allocation of the @@ -1730,8 +1773,7 @@ simplLamBndrs env bndrs = mapAccumLM simplLamBndr env bndrs ------------------ simplNonRecE :: SimplEnv - -> Bool -- True <=> from a lambda - -- False <=> from a let + -> FromWhat -> InId -- The binder, always an Id -- Never a join point -> (InExpr, SimplEnv) -- Rhs of binding (or arg of lambda) @@ -1740,56 +1782,48 @@ simplNonRecE :: SimplEnv -> SimplM (SimplFloats, OutExpr) -- simplNonRecE is used for --- * non-top-level non-recursive non-join-point lets in expressions --- * beta reduction +-- * from=FromLet: a non-top-level non-recursive non-join-point let-expression +-- * from=FromBeta: a binding arising from a beta reduction -- --- simplNonRec env b (rhs, rhs_se) body k +-- simplNonRecE env b (rhs, rhs_se) body k -- = let env in -- cont< let b = rhs_se(rhs) in body > -- -- It deals with strict bindings, via the StrictBind continuation, -- which may abort the whole process. -- --- from_lam=False => the RHS satisfies the let-can-float invariant +-- from_what=FromLet => the RHS satisfies the let-can-float invariant -- Otherwise it may or may not satisfy it. -simplNonRecE env from_lam bndr (rhs, rhs_se) body cont - = assert (isId bndr && not (isJoinId bndr) ) $ - do { (env1, bndr1) <- simplNonRecBndr env bndr - ; let needs_case_binding = needsCaseBinding (idType bndr1) rhs - -- See Note [Dark corner with representation polymorphism] - -- If from_lam=False then needs_case_binding is False, - -- because the binding started as a let, which must - -- satisfy let-can-float - - ; if | from_lam && not needs_case_binding - -- If not from_lam we are coming from a (NonRec bndr rhs) binding - -- and preInlineUnconditionally has been done already; - -- no need to repeat it. But for lambdas we must be careful about - -- preInlineUndonditionally: consider (\(x:Int#). 3) (error "urk") - -- We must not drop the (error "urk"). - , Just env' <- preInlineUnconditionally env NotTopLevel bndr rhs rhs_se - -> do { tick (PreInlineUnconditionally bndr) - ; -- pprTrace "preInlineUncond" (ppr bndr <+> ppr rhs) $ - simplLam env' body cont } - - -- Deal with strict bindings - | isStrictId bndr1 && seCaseCase env - || from_lam && needs_case_binding - -- The important bit here is needs_case_binds; but no need to - -- test it if from_lam is False because then needs_case_binding is False too - -- NB: either way, the RHS may or may not satisfy let-can-float - -- but that's ok for StrictBind. - -> simplExprF (rhs_se `setInScopeFromE` env) rhs - (StrictBind { sc_bndr = bndr, sc_body = body - , sc_env = env, sc_cont = cont, sc_dup = NoDup }) - - -- Deal with lazy bindings - | otherwise - -> do { (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) - ; (floats1, env3) <- simplLazyBind env2 NotTopLevel NonRecursive bndr bndr2 rhs rhs_se - ; (floats2, expr') <- simplLam env3 body cont - ; return (floats1 `addFloats` floats2, expr') } } +simplNonRecE env from_what bndr (rhs, rhs_se) body cont + | assert (isId bndr && not (isJoinId bndr) ) $ + is_strict_bind + = -- Evaluate RHS strictly + simplExprF (rhs_se `setInScopeFromE` env) rhs + (StrictBind { sc_bndr = bndr, sc_body = body, sc_from = from_what + , sc_env = env, sc_cont = cont, sc_dup = NoDup }) + + | otherwise -- Evaluate RHS lazily + = do { (env1, bndr1) <- simplNonRecBndr env bndr + ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) + ; (floats1, env3) <- simplLazyBind env2 NotTopLevel NonRecursive + bndr bndr2 rhs rhs_se + ; (floats2, expr') <- simplNonRecBody env3 from_what body cont + ; return (floats1 `addFloats` floats2, expr') } + + where + is_strict_bind = case from_what of + FromBeta arg_ty | isUnliftedType arg_ty -> True + -- If we are coming from a beta-reduction (FromBeta) we must + -- establish the let-can-float invariant, so go via StrictBind + -- If not, the invariant holds already, and it's optional. + -- Using arg_ty: see Note [Dark corner with representation polymorphism] + -- e.g (\r \(a::TYPE r) \(x::a). blah) @LiftedRep @Int arg + -- When we come to `x=arg` we myst choose lazy/strict correctly + -- It's wrong to err in either directly + + _ -> seCaseCase env && isStrUsedDmd (idDemandInfo bndr) + ------------------ simplRecE :: SimplEnv @@ -1835,7 +1869,7 @@ Note [Avoiding exponential behaviour] One way in which we can get exponential behaviour is if we simplify a big expression, and then re-simplify it -- and then this happens in a deeply-nested way. So we must be jolly careful about re-simplifying -an expression. That is why simplNonRecX does not try +an expression (#13379). That is why simplNonRecX does not try preInlineUnconditionally (unlike simplNonRecE). Example: @@ -2618,15 +2652,10 @@ Is this inefficient? Not really: we are about to walk over the result of the rule firing to simplify it, so occurrence analysis is at most a constant factor. -Possible improvement: occ-anal the rules when putting them in the -database; and in the simplifier just occ-anal the OutExpr arguments. -But that's more complicated and the rule RHS is usually tiny; so I'm -just doing the simple thing. - -Historical note: previously we did occ-anal the rules in Rule.hs, -but failed to occ-anal the OutExpr arguments, which led to the -nasty performance problem described above. - +Note, however, that the rule RHS is /already/ occ-analysed; see +Note [OccInfo in unfoldings and rules] in GHC.Core. There is something +unsatisfactory about doing it twice; but the rule RHS is usually very +small, and this is simple. Note [Optimising tagToEnum#] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2930,7 +2959,7 @@ rebuildCase env scrut case_bndr alts cont where simple_rhs env wfloats case_bndr_rhs bs rhs = assert (null bs) $ - do { (floats1, env') <- simplNonRecX env case_bndr case_bndr_rhs + do { (floats1, env') <- simplAuxBind env case_bndr case_bndr_rhs -- scrut is a constructor application, -- hence satisfies let-can-float invariant ; (floats2, expr') <- simplExprF env' rhs cont @@ -2997,7 +3026,7 @@ rebuildCase env scrut case_bndr alts@[Alt _ bndrs rhs] cont | all_dead_bndrs , doCaseToLet scrut case_bndr = do { tick (CaseElim case_bndr) - ; (floats1, env') <- simplNonRecX env case_bndr scrut + ; (floats1, env') <- simplAuxBind env case_bndr scrut ; (floats2, expr') <- simplExprF env' rhs cont ; return (floats1 `addFloats` floats2, expr') } @@ -3483,12 +3512,11 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont bind_args env' (b:bs') (arg : args) = assert (isId b) $ do { let b' = zap_occ b - -- Note that the binder might be "dead", because it doesn't - -- occur in the RHS; and simplNonRecX may therefore discard - -- it via postInlineUnconditionally. + -- zap_occ: the binder might be "dead", because it doesn't + -- occur in the RHS; and simplAuxBind may therefore discard it. -- Nevertheless we must keep it if the case-binder is alive, -- because it may be used in the con_app. See Note [knownCon occ info] - ; (floats1, env2) <- simplNonRecX env' b' arg -- arg satisfies let-can-float invariant + ; (floats1, env2) <- simplAuxBind env' b' arg -- arg satisfies let-can-float invariant ; (floats2, env3) <- bind_args env2 bs' args ; return (floats1 `addFloats` floats2, env3) } @@ -3514,7 +3542,7 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont ; let con_app = Var (dataConWorkId dc) `mkTyApps` dc_ty_args `mkApps` dc_args - ; simplNonRecX env bndr con_app } + ; simplAuxBind env bndr con_app } ------------------- missingAlt :: SimplEnv -> Id -> [InAlt] -> SimplCont @@ -3621,15 +3649,15 @@ mkDupableContWithDmds env dmds (TickIt t cont) ; return (floats, TickIt t cont') } mkDupableContWithDmds env _ - (StrictBind { sc_bndr = bndr, sc_body = body + (StrictBind { sc_bndr = bndr, sc_body = body, sc_from = from_what , sc_env = se, sc_cont = cont}) -- See Note [Duplicating StrictBind] -- K[ let x = <> in b ] --> join j x = K[ b ] -- j <> = do { let sb_env = se `setInScopeFromE` env ; (sb_env1, bndr') <- simplBinder sb_env bndr - ; (floats1, join_inner) <- simplLam sb_env1 body cont - -- No need to use mkDupableCont before simplLam; we + ; (floats1, join_inner) <- simplNonRecBody sb_env1 from_what body cont + -- No need to use mkDupableCont before simplNonRecBody; we -- use cont once here, and then share the result if necessary ; let join_body = wrapFloats floats1 join_inner @@ -3757,6 +3785,7 @@ mkDupableStrictBind env arg_bndr join_rhs res_ty , StrictBind { sc_bndr = arg_bndr , sc_body = join_rhs , sc_env = zapSubstEnv env + , sc_from = FromLet -- See Note [StaticEnv invariant] in GHC.Core.Opt.Simplify.Utils , sc_dup = OkToDup , sc_cont = mkBoringStop res_ty } ) @@ -4430,7 +4459,9 @@ simplRules env mb_new_id rules bind_cxt ; return (rule { ru_bndrs = bndrs' , ru_fn = fn_name' , ru_args = args' - , ru_rhs = rhs' }) } + , ru_rhs = occurAnalyseExpr rhs' }) } + -- Remember to occ-analyse, to drop dead code. + -- See Note [OccInfo in unfoldings and rules] in GHC.Core {- Note [Simplifying the RHS of a RULE] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -21,7 +21,7 @@ module GHC.Core.Opt.Simplify.Utils ( BindContext(..), bindContextLevel, -- The continuation type - SimplCont(..), DupFlag(..), StaticEnv, + SimplCont(..), DupFlag(..), FromWhat(..), StaticEnv, isSimplified, contIsStop, contIsDupable, contResultType, contHoleType, contHoleScaling, contIsTrivial, contArgs, contIsRhs, @@ -192,6 +192,7 @@ data SimplCont -- or, equivalently, = K[ (\x.b) e ] { sc_dup :: DupFlag -- See Note [DupFlag invariants] , sc_bndr :: InId + , sc_from :: FromWhat , sc_body :: InExpr , sc_env :: StaticEnv -- See Note [StaticEnv invariant] , sc_cont :: SimplCont } @@ -213,6 +214,8 @@ data SimplCont type StaticEnv = SimplEnv -- Just the static part is relevant +data FromWhat = FromLet | FromBeta OutType + -- See Note [DupFlag invariants] data DupFlag = NoDup -- Unsimplified, might be big | Simplified -- Simplified ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -63,6 +63,7 @@ import GHC.Core.Tidy ( tidyRules ) import GHC.Core.Map.Expr ( eqCoreExpr ) import GHC.Core.Opt.Arity( etaExpandToJoinPointRule ) import GHC.Core.Make ( mkCoreLams ) +import GHC.Core.Opt.OccurAnal( occurAnalyseExpr ) import GHC.Tc.Utils.TcType ( tcSplitTyConApp_maybe ) import GHC.Builtin.Types ( anyTypeOfKind ) @@ -189,13 +190,18 @@ mkRule :: Module -> Bool -> Bool -> RuleName -> Activation -- ^ Used to make 'CoreRule' for an 'Id' defined in the module being -- compiled. See also 'GHC.Core.CoreRule' mkRule this_mod is_auto is_local name act fn bndrs args rhs - = Rule { ru_name = name, ru_fn = fn, ru_act = act, - ru_bndrs = bndrs, ru_args = args, - ru_rhs = rhs, - ru_rough = roughTopNames args, - ru_origin = this_mod, - ru_orphan = orph, - ru_auto = is_auto, ru_local = is_local } + = Rule { ru_name = name + , ru_act = act + , ru_fn = fn + , ru_bndrs = bndrs + , ru_args = args + , ru_rhs = occurAnalyseExpr rhs + -- See Note [OccInfo in unfoldings and rules] + , ru_rough = roughTopNames args + , ru_origin = this_mod + , ru_orphan = orph + , ru_auto = is_auto + , ru_local = is_local } where -- Compute orphanhood. See Note [Orphans] in GHC.Core.InstEnv -- A rule is an orphan only if none of the variables ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -513,8 +513,8 @@ bindNonRec bndr rhs body -- | Tests whether we have to use a @case@ rather than @let@ binding for this -- expression as per the invariants of 'CoreExpr': see "GHC.Core#let_can_float_invariant" needsCaseBinding :: Type -> CoreExpr -> Bool -needsCaseBinding ty rhs = - mightBeUnliftedType ty && not (exprOkForSpeculation rhs) +needsCaseBinding ty rhs + = mightBeUnliftedType ty && not (exprOkForSpeculation rhs) -- Make a case expression instead of a let -- These can arise either from the desugarer, -- or from beta reductions: (\x.e) (x +# y) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4939,6 +4939,7 @@ needSourceNotes dflags = debugLevel dflags > 0 -- LinkerInfo contains any extra options needed by the system linker. data LinkerInfo = GnuLD [Option] + | Mold [Option] | GnuGold [Option] | LlvmLLD [Option] | DarwinLD [Option] ===================================== compiler/GHC/SysTools/Info.hs ===================================== @@ -70,6 +70,7 @@ The flag is only needed on ELF systems. On Windows (PE) and Mac OS X neededLinkArgs :: LinkerInfo -> [Option] neededLinkArgs (GnuLD o) = o +neededLinkArgs (Mold o) = o neededLinkArgs (GnuGold o) = o neededLinkArgs (LlvmLLD o) = o neededLinkArgs (DarwinLD o) = o @@ -106,6 +107,10 @@ getLinkerInfo' logger dflags = do -- see Note [ELF needed shared libs] "-Wl,--no-as-needed"]) + | any ("mold" `isPrefixOf`) stdo = + return (Mold $ map Option [ --see Note [ELF needed shared libs] + "-Wl,--no-as-needed"]) + | any ("GNU gold" `isPrefixOf`) stdo = -- GNU gold only needs --no-as-needed. #10110. -- ELF specific flag, see Note [ELF needed shared libs] ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -723,12 +723,14 @@ setIdCprSig id sig = modifyIdInfo (\info -> setCprSigInfo info sig) id zapIdDmdSig :: Id -> Id zapIdDmdSig id = modifyIdInfo (`setDmdSigInfo` nopSig) id --- | This predicate says whether the 'Id' has a strict demand placed on it or --- has a type such that it can always be evaluated strictly (i.e an --- unlifted type, as of GHC 7.6). We need to --- check separately whether the 'Id' has a so-called \"strict type\" because if --- the demand for the given @id@ hasn't been computed yet but @id@ has a strict --- type, we still want @isStrictId id@ to be @True at . +-- | `isStrictId` says whether either +-- (a) the 'Id' has a strict demand placed on it or +-- (b) definitely has a \"strict type\", such that it can always be +-- evaluated strictly (i.e an unlifted type) +-- We need to check (b) as well as (a), because when the demand for the +-- given `id` hasn't been computed yet but `id` has a strict +-- type, we still want `isStrictId id` to be `True`. +-- Returns False if the type is levity polymorphic; False is always safe. isStrictId :: Id -> Bool isStrictId id | assertPpr (isId id) (text "isStrictId: not an id: " <+> ppr id) $ ===================================== compiler/GHC/Unit/Module/ModIface.hs ===================================== @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE NamedFieldPuns #-} module GHC.Unit.Module.ModIface ( ModIface @@ -549,20 +550,58 @@ emptyIfaceHashCache _occ = Nothing -- Take care, this instance only forces to the degree necessary to -- avoid major space leaks. -instance (NFData (IfaceBackendExts (phase :: ModIfacePhase)), NFData (IfaceDeclExts (phase :: ModIfacePhase))) => NFData (ModIface_ phase) where - rnf (ModIface f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 - f13 f14 f15 f16 f17 f18 f19 f20 f21 f22 f23 f24) = - rnf f1 `seq` rnf f2 `seq` f3 `seq` f4 `seq` f5 `seq` f6 `seq` rnf f7 `seq` f8 `seq` - f9 `seq` rnf f10 `seq` rnf f11 `seq` rnf f12 `seq` f13 `seq` rnf f14 `seq` rnf f15 `seq` rnf f16 `seq` - rnf f17 `seq` f18 `seq` rnf f19 `seq` rnf f20 `seq` rnf f21 `seq` f22 `seq` f23 `seq` rnf f24 +instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase)) + , NFData (IfaceDeclExts (phase :: ModIfacePhase)) + ) => NFData (ModIface_ phase) where + rnf (ModIface{ mi_module, mi_sig_of, mi_hsc_src, mi_deps, mi_usages + , mi_exports, mi_used_th, mi_fixities, mi_warns, mi_anns + , mi_decls, mi_extra_decls, mi_globals, mi_insts + , mi_fam_insts, mi_rules, mi_hpc, mi_trust, mi_trust_pkg + , mi_complete_matches, mi_docs, mi_final_exts + , mi_ext_fields, mi_src_hash}) + = rnf mi_module + `seq` rnf mi_sig_of + `seq` mi_hsc_src + `seq` mi_deps + `seq` mi_usages + `seq` mi_exports + `seq` rnf mi_used_th + `seq` mi_fixities + `seq` mi_warns + `seq` rnf mi_anns + `seq` rnf mi_decls + `seq` rnf mi_extra_decls + `seq` mi_globals + `seq` rnf mi_insts + `seq` rnf mi_fam_insts + `seq` rnf mi_rules + `seq` rnf mi_hpc + `seq` mi_trust + `seq` rnf mi_trust_pkg + `seq` rnf mi_complete_matches + `seq` rnf mi_docs + `seq` mi_final_exts + `seq` mi_ext_fields + `seq` rnf mi_src_hash `seq` () - instance NFData (ModIfaceBackend) where - rnf (ModIfaceBackend f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13) - = rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` - rnf f5 `seq` rnf f6 `seq` rnf f7 `seq` rnf f8 `seq` - rnf f9 `seq` rnf f10 `seq` rnf f11 `seq` rnf f12 `seq` rnf f13 + rnf (ModIfaceBackend{ mi_iface_hash, mi_mod_hash, mi_flag_hash, mi_opt_hash + , mi_hpc_hash, mi_plugin_hash, mi_orphan, mi_finsts, mi_exp_hash + , mi_orphan_hash, mi_warn_fn, mi_fix_fn, mi_hash_fn}) + = rnf mi_iface_hash + `seq` rnf mi_mod_hash + `seq` rnf mi_flag_hash + `seq` rnf mi_opt_hash + `seq` rnf mi_hpc_hash + `seq` rnf mi_plugin_hash + `seq` rnf mi_orphan + `seq` rnf mi_finsts + `seq` rnf mi_exp_hash + `seq` rnf mi_orphan_hash + `seq` rnf mi_warn_fn + `seq` rnf mi_fix_fn + `seq` rnf mi_hash_fn forceModIface :: ModIface -> IO () ===================================== libraries/base/tests/all.T ===================================== @@ -79,7 +79,9 @@ test('length001', # excessive amounts of stack space. So we specifically set a low # stack limit and mark it as failing under a few conditions. [extra_run_opts('+RTS -K8m -RTS'), - expect_fail_for(['normal', 'threaded1', 'llvm', 'nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc'])], + expect_fail_for(['normal', 'threaded1', 'llvm', 'nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc']), + # JS doesn't support stack limit so the test sometimes passes just fine. We decrease the timeout duration to force the failure. + when(js_arch(), run_timeout_multiplier(0.2))], compile_and_run, ['']) test('ratio001', normal, compile_and_run, ['']) ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -31,6 +31,7 @@ module Language.Haskell.TH.Syntax -- $infix ) where +import qualified Data.Fixed as Fixed import Data.Data hiding (Fixity(..)) import Data.IORef import System.IO.Unsafe ( unsafePerformIO ) @@ -1056,6 +1057,15 @@ instance Lift Natural where liftTyped x = unsafeCodeCoerce (lift x) lift x = return (LitE (IntegerL (fromIntegral x))) +instance Lift (Fixed.Fixed a) where + liftTyped x = unsafeCodeCoerce (lift x) + lift (Fixed.MkFixed x) = do + ex <- lift x + return (ConE mkFixedName `AppE` ex) + where + mkFixedName = + mkNameG DataName "base" "Data.Fixed" "MkFixed" + instance Integral a => Lift (Ratio a) where liftTyped x = unsafeCodeCoerce (lift x) lift x = return (LitE (RationalL (toRational x))) ===================================== libraries/template-haskell/changelog.md ===================================== @@ -7,6 +7,7 @@ * Add `TypeDataD` constructor to the `Dec` type for `type data` declarations (GHC proposal #106). + * Add `instance Lift (Fixed a)` ## 2.19.0.0 ===================================== testsuite/driver/testlib.py ===================================== @@ -129,14 +129,17 @@ def no_deps( name, opts): def skip( name, opts ): opts.skip = True +def js_arch() -> bool: + return arch("javascript"); + # disable test on JS arch def js_skip( name, opts ): - if arch("javascript"): + if js_arch(): skip(name,opts) # expect broken for the JS backend def js_broken( bug: IssueNumber ): - if arch("javascript"): + if js_arch(): return expect_broken(bug); else: return normal; ===================================== testsuite/tests/simplCore/should_compile/T22761.hs ===================================== @@ -0,0 +1,40 @@ +module T22761 where + +import T22761a + +newtype Mod m = Mod m deriving Num + +gcdExt :: Integer -> (Integer, Integer) +gcdExt x = go 0 x + where + go !_ 0 = (1, 1) + go r _ = go r r + +pow :: (Num m) => Mod m -> Mod m +pow x = x*x*x +{-# NOINLINE [1] pow #-} +{-# RULES +"powMod/3/Int" forall x. pow x = x*x*x +#-} + + +-- GHC puts `boo1` after `wom1` (since they don't appear connected) +-- Then { wom1 = foo True } rewrites to { wom1 = boo False } +-- so we need to do glomming. And that triggers the bug +-- in the RULE for `pow`! +-- +-- wom2/boo2 are there to still elicit the bug if +-- GHC reverses its default ordering + +{-# RULES +"wombat1" foo True = boo1 False +#-} + +wom1 = foo True +boo1 x = x + +{-# RULES +"wombat2" foo True = boo2 False +#-} +boo2 x = x +wom2 = foo True ===================================== testsuite/tests/simplCore/should_compile/T22761a.hs ===================================== @@ -0,0 +1,4 @@ +module T22761a where + +{-# NOINLINE [0] foo #-} +foo x = x ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -471,5 +471,6 @@ test('T22611', [when(wordsize(32), skip), grep_errmsg(r'\$salterF') ], compile, test('T22715_2', normal, multimod_compile, ['T22715_2', '-v0 -O -fspecialise-aggressively']) test('T22802', normal, compile, ['-O']) test('T15205', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) +test('T22761', normal, multimod_compile, ['T22761', '-O2 -v0']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f8370c8b77ba1a7db7db0474139ac70565e2b0ba...c4faa59ad4de5e67904937410d24e742e8c7104c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f8370c8b77ba1a7db7db0474139ac70565e2b0ba...c4faa59ad4de5e67904937410d24e742e8c7104c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 10 13:28:59 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Fri, 10 Feb 2023 08:28:59 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T22948 Message-ID: <63e6469bf1e88_1cf8af5269817950@gitlab.mail> Ryan Scott pushed new branch wip/T22948 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22948 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 10 13:40:16 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Fri, 10 Feb 2023 08:40:16 -0500 Subject: [Git][ghc/ghc] Pushed new tag ghc-9.2.6-release Message-ID: <63e64940c45c9_1cf8af526ac2168c@gitlab.mail> Zubin pushed new tag ghc-9.2.6-release at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/ghc-9.2.6-release You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 10 14:53:36 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 10 Feb 2023 09:53:36 -0500 Subject: [Git][ghc/ghc][master] Add Lift instance for Fixed Message-ID: <63e65a70bd839_1cf8af526e8402bb@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - 2 changed files: - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - libraries/template-haskell/changelog.md Changes: ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -31,6 +31,7 @@ module Language.Haskell.TH.Syntax -- $infix ) where +import qualified Data.Fixed as Fixed import Data.Data hiding (Fixity(..)) import Data.IORef import System.IO.Unsafe ( unsafePerformIO ) @@ -1056,6 +1057,15 @@ instance Lift Natural where liftTyped x = unsafeCodeCoerce (lift x) lift x = return (LitE (IntegerL (fromIntegral x))) +instance Lift (Fixed.Fixed a) where + liftTyped x = unsafeCodeCoerce (lift x) + lift (Fixed.MkFixed x) = do + ex <- lift x + return (ConE mkFixedName `AppE` ex) + where + mkFixedName = + mkNameG DataName "base" "Data.Fixed" "MkFixed" + instance Integral a => Lift (Ratio a) where liftTyped x = unsafeCodeCoerce (lift x) lift x = return (LitE (RationalL (toRational x))) ===================================== libraries/template-haskell/changelog.md ===================================== @@ -7,6 +7,7 @@ * Add `TypeDataD` constructor to the `Dec` type for `type data` declarations (GHC proposal #106). + * Add `instance Lift (Fixed a)` ## 2.19.0.0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/59556235a8d216b6274ad7966b70b585f585cdaa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/59556235a8d216b6274ad7966b70b585f585cdaa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 10 14:53:42 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Fri, 10 Feb 2023 09:53:42 -0500 Subject: [Git][ghc/ghc][wip/T22948] Don't generate datacon wrappers for `type data` declarations Message-ID: <63e65a76523bc_1cf8af526c04045a@gitlab.mail> Ryan Scott pushed to branch wip/T22948 at Glasgow Haskell Compiler / GHC Commits: e07c7fd1 by Ryan Scott at 2023-02-10T09:53:30-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch: * Modifies the criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper to factor in whether or not its parent data type was declared with `type data`. * Deletes some redundant wrapper-checking criteria in `GHC.Iface.Tidy.getTyConImplicitBinds`, as these are subsumed by `mkDataConRep`. After this patch, all of the criteria are listed in `mkDataConRep`. Fixes #22948. - - - - - 5 changed files: - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Types/Id/Make.hs - + testsuite/tests/type-data/should_run/T22948.hs - testsuite/tests/type-data/should_run/all.T Changes: ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -614,9 +614,8 @@ getImplicitBinds tc = cls_binds ++ getTyConImplicitBinds tc cls_binds = maybe [] getClassImplicitBinds (tyConClass_maybe tc) getTyConImplicitBinds :: TyCon -> [CoreBind] -getTyConImplicitBinds tc - | isNewTyCon tc = [] -- See Note [Compulsory newtype unfolding] in GHC.Types.Id.Make - | otherwise = map get_defn (mapMaybe dataConWrapId_maybe (tyConDataCons tc)) +getTyConImplicitBinds tc = + map get_defn (mapMaybe dataConWrapId_maybe (tyConDataCons tc)) getClassImplicitBinds :: Class -> [CoreBind] getClassImplicitBinds cls ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -2132,6 +2132,20 @@ The main parts of the implementation are: `type data` declarations. When these are converted back to Hs types in a splice, the constructors are placed in the TcCls namespace. +* A `type data` declaration _never_ generates wrappers for its data + constructors, as they only make sense for value-level data constructors. + This extends to `type data` declarations implemented as GADTs, such as + this example from #22948: + + type data T a where + A :: T Int + B :: T a + + If `T` were an ordinary `data` declaration, then `A` would have a wrapper + to account for the GADT-like equality in its return type. Because `T` is + declared as a `type data` declaration, however, the wrapper is omitted. + See `wrapped_reqd` in GHC.Types.Id.Make.mkDataConRep` for the place where + this check is implemented. -} warnNoDerivStrat :: Maybe (LDerivStrategy GhcRn) ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -789,20 +789,40 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con (unboxers, boxers) = unzip wrappers (rep_tys, rep_strs) = unzip (concat rep_tys_w_strs) + -- This is True if the data constructor or class dictionary constructor + -- needs a wrapper. This wrapper is injected into the program later in the + -- CoreTidy pass. See Note [Injecting implicit bindings] in GHC.Iface.Tidy, + -- along with the accompanying implementation in getTyConImplicitBinds. wrapper_reqd = (not new_tycon -- (Most) newtypes have only a worker, with the exception -- of some newtypes written with GADT syntax. See below. - && (any isBanged (ev_ibangs ++ arg_ibangs))) + && (any isBanged (ev_ibangs ++ arg_ibangs)) -- Some forcing/unboxing (includes eq_spec) - || isFamInstTyCon tycon -- Cast result - || dataConUserTyVarsNeedWrapper data_con + && isFamInstTyCon tycon) + -- Cast the result. Note that we _don't_ need to do this + -- for newtype instances—see + -- Note [Compulsory newtype unfolding]. + || (dataConUserTyVarsNeedWrapper data_con -- If the data type was written with GADT syntax and -- orders the type variables differently from what the -- worker expects, it needs a data con wrapper to reorder -- the type variables. -- See Note [Data con wrappers and GADT syntax]. -- NB: All GADTs return true from this function + && not (isTypeDataTyCon tycon)) + -- An exception to this rule are `type data` declarations. + -- Their data constructors only live at the type level and + -- therefore do not need wrappers. + -- See Note [Type data declarations] in GHC.Rename.Module. + -- + -- Note that all of the other disjuncts in the definition + -- of wrapper_reqd will be False for `type data` + -- declarations, as: + -- + -- - They cannot be newtypes or have strict fields + -- - They cannot be data family instances + -- - They cannot have datatype contexts || not (null stupid_theta) -- If the data constructor has a datatype context, -- we need a wrapper in order to drop the stupid arguments. ===================================== testsuite/tests/type-data/should_run/T22948.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeData #-} +module Main where + +type data T a where + A :: T Int + B :: T a + +main = return () ===================================== testsuite/tests/type-data/should_run/all.T ===================================== @@ -1,3 +1,4 @@ test('T22332a', exit_code(1), compile_and_run, ['']) test('T22315b', extra_files(['T22315b.hs']), ghci_script, ['T22315b.script']) test('T22500', normal, compile_and_run, ['']) +test('T22948', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e07c7fd12738a4b5f411d9c5d5e6a700d1e144d4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e07c7fd12738a4b5f411d9c5d5e6a700d1e144d4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 10 14:54:08 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 10 Feb 2023 09:54:08 -0500 Subject: [Git][ghc/ghc][master] Testsuite: decrease length001 timeout for JS (#22921) Message-ID: <63e65a90ebe42_1cf8af52698437a6@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 2 changed files: - libraries/base/tests/all.T - testsuite/driver/testlib.py Changes: ===================================== libraries/base/tests/all.T ===================================== @@ -79,7 +79,9 @@ test('length001', # excessive amounts of stack space. So we specifically set a low # stack limit and mark it as failing under a few conditions. [extra_run_opts('+RTS -K8m -RTS'), - expect_fail_for(['normal', 'threaded1', 'llvm', 'nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc'])], + expect_fail_for(['normal', 'threaded1', 'llvm', 'nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc']), + # JS doesn't support stack limit so the test sometimes passes just fine. We decrease the timeout duration to force the failure. + when(js_arch(), run_timeout_multiplier(0.2))], compile_and_run, ['']) test('ratio001', normal, compile_and_run, ['']) ===================================== testsuite/driver/testlib.py ===================================== @@ -129,14 +129,17 @@ def no_deps( name, opts): def skip( name, opts ): opts.skip = True +def js_arch() -> bool: + return arch("javascript"); + # disable test on JS arch def js_skip( name, opts ): - if arch("javascript"): + if js_arch(): skip(name,opts) # expect broken for the JS backend def js_broken( bug: IssueNumber ): - if arch("javascript"): + if js_arch(): return expect_broken(bug); else: return normal; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c44e5f30caca390441e6efa7b9bdab4e698afd31 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c44e5f30caca390441e6efa7b9bdab4e698afd31 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 10 14:54:45 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 10 Feb 2023 09:54:45 -0500 Subject: [Git][ghc/ghc][master] compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` Message-ID: <63e65ab567a61_1cf8af526ac4898c@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1 changed file: - compiler/GHC/Unit/Module/ModIface.hs Changes: ===================================== compiler/GHC/Unit/Module/ModIface.hs ===================================== @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE NamedFieldPuns #-} module GHC.Unit.Module.ModIface ( ModIface @@ -549,20 +550,58 @@ emptyIfaceHashCache _occ = Nothing -- Take care, this instance only forces to the degree necessary to -- avoid major space leaks. -instance (NFData (IfaceBackendExts (phase :: ModIfacePhase)), NFData (IfaceDeclExts (phase :: ModIfacePhase))) => NFData (ModIface_ phase) where - rnf (ModIface f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 - f13 f14 f15 f16 f17 f18 f19 f20 f21 f22 f23 f24) = - rnf f1 `seq` rnf f2 `seq` f3 `seq` f4 `seq` f5 `seq` f6 `seq` rnf f7 `seq` f8 `seq` - f9 `seq` rnf f10 `seq` rnf f11 `seq` rnf f12 `seq` f13 `seq` rnf f14 `seq` rnf f15 `seq` rnf f16 `seq` - rnf f17 `seq` f18 `seq` rnf f19 `seq` rnf f20 `seq` rnf f21 `seq` f22 `seq` f23 `seq` rnf f24 +instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase)) + , NFData (IfaceDeclExts (phase :: ModIfacePhase)) + ) => NFData (ModIface_ phase) where + rnf (ModIface{ mi_module, mi_sig_of, mi_hsc_src, mi_deps, mi_usages + , mi_exports, mi_used_th, mi_fixities, mi_warns, mi_anns + , mi_decls, mi_extra_decls, mi_globals, mi_insts + , mi_fam_insts, mi_rules, mi_hpc, mi_trust, mi_trust_pkg + , mi_complete_matches, mi_docs, mi_final_exts + , mi_ext_fields, mi_src_hash}) + = rnf mi_module + `seq` rnf mi_sig_of + `seq` mi_hsc_src + `seq` mi_deps + `seq` mi_usages + `seq` mi_exports + `seq` rnf mi_used_th + `seq` mi_fixities + `seq` mi_warns + `seq` rnf mi_anns + `seq` rnf mi_decls + `seq` rnf mi_extra_decls + `seq` mi_globals + `seq` rnf mi_insts + `seq` rnf mi_fam_insts + `seq` rnf mi_rules + `seq` rnf mi_hpc + `seq` mi_trust + `seq` rnf mi_trust_pkg + `seq` rnf mi_complete_matches + `seq` rnf mi_docs + `seq` mi_final_exts + `seq` mi_ext_fields + `seq` rnf mi_src_hash `seq` () - instance NFData (ModIfaceBackend) where - rnf (ModIfaceBackend f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13) - = rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` - rnf f5 `seq` rnf f6 `seq` rnf f7 `seq` rnf f8 `seq` - rnf f9 `seq` rnf f10 `seq` rnf f11 `seq` rnf f12 `seq` rnf f13 + rnf (ModIfaceBackend{ mi_iface_hash, mi_mod_hash, mi_flag_hash, mi_opt_hash + , mi_hpc_hash, mi_plugin_hash, mi_orphan, mi_finsts, mi_exp_hash + , mi_orphan_hash, mi_warn_fn, mi_fix_fn, mi_hash_fn}) + = rnf mi_iface_hash + `seq` rnf mi_mod_hash + `seq` rnf mi_flag_hash + `seq` rnf mi_opt_hash + `seq` rnf mi_hpc_hash + `seq` rnf mi_plugin_hash + `seq` rnf mi_orphan + `seq` rnf mi_finsts + `seq` rnf mi_exp_hash + `seq` rnf mi_orphan_hash + `seq` rnf mi_warn_fn + `seq` rnf mi_fix_fn + `seq` rnf mi_hash_fn forceModIface :: ModIface -> IO () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/133516af8426d775fa0dc75c787edd56299ee6cf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/133516af8426d775fa0dc75c787edd56299ee6cf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 10 15:17:07 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 10 Feb 2023 10:17:07 -0500 Subject: [Git][ghc/ghc][wip/T21909] 10 commits: Refactor the simplifier a bit to fix #22761 Message-ID: <63e65ff36141c_1cf8af526e852932@gitlab.mail> Apoorv Ingle pushed to branch wip/T21909 at Glasgow Haskell Compiler / GHC Commits: e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1360d064 by Apoorv Ingle at 2023-02-10T09:16:39-06:00 Fixes #21909 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag in `CDictCan.cc_pend_sc`. Pending Givens get a fuel of 3 to start of with while Wanted constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints. Added tests T21909, T21909b - - - - - 3b745764 by Apoorv Ingle at 2023-02-10T09:16:39-06:00 Change `qci_pend_sc` from `Bool` to `ExpansionFuel` - - - - - 4e460485 by Apoorv Ingle at 2023-02-10T09:16:39-06:00 abstract default fuel into constants - - - - - b5ab37d3 by Apoorv Ingle at 2023-02-10T09:16:39-06:00 added note [SimplifyInfer and UndecidableSuperClasses] - - - - - b8c266eb by Apoorv Ingle at 2023-02-10T09:16:39-06:00 make expansion fuel a dynamic flag - - - - - 28 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings/Constants.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Unit/Module/ModIface.hs - docs/users_guide/expected-undocumented-flags.txt - libraries/base/tests/all.T - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - libraries/template-haskell/changelog.md - testsuite/driver/testlib.py - + testsuite/tests/simplCore/should_compile/T22761.hs - + testsuite/tests/simplCore/should_compile/T22761a.hs - testsuite/tests/simplCore/should_compile/all.T - + testsuite/tests/typecheck/should_compile/T21909.hs - + testsuite/tests/typecheck/should_compile/T21909b.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -1300,16 +1300,19 @@ data Unfolding df_args :: [CoreExpr] -- Args of the data con: types, superclasses and methods, } -- in positional order - | CoreUnfolding { -- An unfolding for an Id with no pragma, - -- or perhaps a NOINLINE pragma - -- (For NOINLINE, the phase, if any, is in the - -- InlinePragInfo for this Id.) - uf_tmpl :: CoreExpr, -- Template; occurrence info is correct - uf_src :: UnfoldingSource, -- Where the unfolding came from - uf_is_top :: Bool, -- True <=> top level binding - uf_cache :: UnfoldingCache, -- Cache of flags computable from the expr - -- See Note [Tying the 'CoreUnfolding' knot] - uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template. + | CoreUnfolding { -- An unfolding for an Id with no pragma, + -- or perhaps a NOINLINE pragma + -- (For NOINLINE, the phase, if any, is in the + -- InlinePragInfo for this Id.) + uf_tmpl :: CoreExpr, -- The unfolding itself (aka "template") + -- Always occ-analysed; + -- See Note [OccInfo in unfoldings and rules] + + uf_src :: UnfoldingSource, -- Where the unfolding came from + uf_is_top :: Bool, -- True <=> top level binding + uf_cache :: UnfoldingCache, -- Cache of flags computable from the expr + -- See Note [Tying the 'CoreUnfolding' knot] + uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template. } -- ^ An unfolding with redundant cached information. Parameters: -- @@ -1637,14 +1640,37 @@ change was requested by Roman, but it seems to make sense. Note [OccInfo in unfoldings and rules] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In unfoldings and rules, we guarantee that the template is occ-analysed, -so that the occurrence info on the binders is correct. This is important, -because the Simplifier does not re-analyse the template when using it. If -the occurrence info is wrong - - We may get more simplifier iterations than necessary, because - once-occ info isn't there - - More seriously, we may get an infinite loop if there's a Rec - without a loop breaker marked +In unfoldings and rules, we guarantee that the template is occ-analysed, so +that the occurrence info on the binders is correct. That way, when the +Simplifier inlines an unfolding, it doesn't need to occ-analysis it first. +(The Simplifier is designed to simplify occ-analysed expressions.) + +Given this decision it's vital that we do *always* do it. + +* If we don't, we may get more simplifier iterations than necessary, + because once-occ info isn't there + +* More seriously, we may get an infinite loop if there's a Rec without a + loop breaker marked. + +* Or we may get code that mentions variables not in scope: #22761 + e.g. Suppose we have a stable unfolding : \y. let z = p+1 in 3 + Then the pre-simplifier occ-anal will occ-anal the unfolding + (redundantly perhaps, but we need its free vars); this will not report + the use of `p`; so p's binding will be discarded, and yet `p` is still + mentioned. + + Better to occ-anal the unfolding at birth, which will drop the + z-binding as dead code. (Remember, it's the occurrence analyser that + drops dead code.) + +* Another example is #8892: + \x -> letrec { f = ...g...; g* = f } in body + where g* is (for some strange reason) the loop breaker. If we don't + occ-anal it when reading it in, we won't mark g as a loop breaker, and we + may inline g entirely in body, dropping its binding, and leaving the + occurrence in f out of scope. This happened in #8892, where the unfolding + in question was a DFun unfolding. ************************************************************************ ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -3088,8 +3088,15 @@ etaExpandToJoinPointRule join_arity rule@(Rule { ru_bndrs = bndrs, ru_rhs = rhs | need_args < 0 = pprPanic "etaExpandToJoinPointRule" (ppr join_arity $$ ppr rule) | otherwise - = rule { ru_bndrs = bndrs ++ new_bndrs, ru_args = args ++ new_args - , ru_rhs = new_rhs } + = rule { ru_bndrs = bndrs ++ new_bndrs + , ru_args = args ++ new_args + , ru_rhs = new_rhs } + -- new_rhs really ought to be occ-analysed (see GHC.Core Note + -- [OccInfo in unfoldings and rules]), but it makes a module loop to + -- do so; it doesn't happen often; and it doesn't really matter if + -- the outer binders have bogus occurrence info; and new_rhs won't + -- have dead code if rhs didn't. + where need_args = join_arity - length args (new_bndrs, new_rhs) = etaBodyForJoinPoint need_args rhs ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -2165,6 +2165,17 @@ So we have a fast-path that keeps the old tree if the occ_bs_env is empty. This just saves a bit of allocation and reconstruction; not a big deal. +This fast path exposes a tricky cornder, though (#22761). Supose we have + Unfolding = \x. let y = foo in x+1 +which includes a dead binding for `y`. In occAnalUnfolding we occ-anal +the unfolding and produce /no/ occurrences of `foo` (since `y` is +dead). But if we discard the occ-analysed syntax tree (which we do on +our fast path), and use the old one, we still /have/ an occurrence of +`foo` -- and that can lead to out-of-scope variables (#22761). + +Solution: always keep occ-analysed trees in unfoldings and rules, so they +have no dead code. See Note [OccInfo in unfoldings and rules] in GHC.Core. + Note [Cascading inlines] ~~~~~~~~~~~~~~~~~~~~~~~~ By default we use an rhsCtxt for the RHS of a binding. This tells the ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -1065,7 +1065,7 @@ subst_id_bndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) -- See Note [Bangs in the Simplifier] !id1 = uniqAway in_scope old_id !id2 = substIdType env id1 - !id3 = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding + !id3 = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding -- and fragile OccInfo !new_id = adjust_type id3 ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -319,14 +319,14 @@ simplLazyBind :: SimplEnv -> TopLevelFlag -> RecFlag -> InId -> OutId -- Binder, both pre-and post simpl -- Not a JoinId - -- The OutId has IdInfo, except arity, unfolding + -- The OutId has IdInfo (notably RULES), + -- except arity, unfolding -- Ids only, no TyVars -> InExpr -> SimplEnv -- The RHS and its environment -> SimplM (SimplFloats, SimplEnv) -- Precondition: the OutId is already in the InScopeSet of the incoming 'env' -- Precondition: not a JoinId -- Precondition: rhs obeys the let-can-float invariant --- NOT used for JoinIds simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se = assert (isId bndr ) assertPpr (not (isJoinId bndr)) (ppr bndr) $ @@ -398,48 +398,45 @@ simplJoinBind env is_rec cont old_bndr new_bndr rhs rhs_se ; completeBind env (BC_Join is_rec cont) old_bndr new_bndr rhs' } -------------------------- -simplNonRecX :: SimplEnv +simplAuxBind :: SimplEnv -> InId -- Old binder; not a JoinId -> OutExpr -- Simplified RHS -> SimplM (SimplFloats, SimplEnv) --- A specialised variant of simplNonRec used when the RHS is already --- simplified, notably in knownCon. It uses case-binding where necessary. +-- A specialised variant of completeBindX used to construct non-recursive +-- auxiliary bindings, notably in knownCon. +-- +-- The binder comes from a case expression (case binder or alternative) +-- and so does not have rules, inline pragmas etc. -- -- Precondition: rhs satisfies the let-can-float invariant -simplNonRecX env bndr new_rhs - | assertPpr (not (isJoinId bndr)) (ppr bndr) $ +simplAuxBind env bndr new_rhs + | assertPpr (isId bndr && not (isJoinId bndr)) (ppr bndr) $ isDeadBinder bndr -- Not uncommon; e.g. case (a,b) of c { (p,q) -> p } = return (emptyFloats env, env) -- Here c is dead, and we avoid - -- creating the binding c = (a,b) - - | Coercion co <- new_rhs - = return (emptyFloats env, extendCvSubst env bndr co) + -- creating the binding c = (a,b) + -- The cases would be inlined unconditionally by completeBind: + -- but it seems not uncommon, and avoids faff to do it here + -- This is safe because it's only used for auxiliary bindings, which + -- have no NOLINE pragmas, nor RULEs | exprIsTrivial new_rhs -- Short-cut for let x = y in ... - -- This case would ultimately land in postInlineUnconditionally - -- but it seems not uncommon, and avoids a lot of faff to do it here - = return (emptyFloats env - , extendIdSubst env bndr (DoneEx new_rhs Nothing)) + = return ( emptyFloats env + , case new_rhs of + Coercion co -> extendCvSubst env bndr co + _ -> extendIdSubst env bndr (DoneEx new_rhs Nothing) ) | otherwise - = do { (env1, new_bndr) <- simplBinder env bndr - ; let is_strict = isStrictId new_bndr - -- isStrictId: use new_bndr because the InId bndr might not have - -- a fixed runtime representation, which isStrictId doesn't expect - -- c.f. Note [Dark corner with representation polymorphism] - - ; (rhs_floats, rhs1) <- prepareBinding env NotTopLevel NonRecursive is_strict - new_bndr (emptyFloats env) new_rhs - -- NB: it makes a surprisingly big difference (5% in compiler allocation - -- in T9630) to pass 'env' rather than 'env1'. It's fine to pass 'env', - -- because this is simplNonRecX, so bndr is not in scope in the RHS. - - ; (bind_float, env2) <- completeBind (env1 `setInScopeFromF` rhs_floats) - (BC_Let NotTopLevel NonRecursive) + = do { -- ANF-ise the RHS + let !occ_fs = getOccFS bndr + ; (anf_floats, rhs1) <- prepareRhs env NotTopLevel occ_fs new_rhs + ; unless (isEmptyLetFloats anf_floats) (tick LetFloatFromLet) + ; let rhs_floats = emptyFloats env `addLetFloats` anf_floats + + -- Simplify the binder and complete the binding + ; (env1, new_bndr) <- simplBinder (env `setInScopeFromF` rhs_floats) bndr + ; (bind_float, env2) <- completeBind env1 (BC_Let NotTopLevel NonRecursive) bndr new_bndr rhs1 - -- Must pass env1 to completeBind in case simplBinder had to clone, - -- and extended the substitution with [bndr :-> new_bndr] ; return (rhs_floats `addFloats` bind_float, env2) } @@ -761,49 +758,54 @@ prepareRhs :: HasDebugCallStack -- x = Just a -- See Note [prepareRhs] prepareRhs env top_lvl occ rhs0 - = do { (_is_exp, floats, rhs1) <- go 0 rhs0 - ; return (floats, rhs1) } + | is_expandable = anfise rhs0 + | otherwise = return (emptyLetFloats, rhs0) where - go :: Int -> OutExpr -> SimplM (Bool, LetFloats, OutExpr) - go n_val_args (Cast rhs co) - = do { (is_exp, floats, rhs') <- go n_val_args rhs - ; return (is_exp, floats, Cast rhs' co) } - go n_val_args (App fun (Type ty)) - = do { (is_exp, floats, rhs') <- go n_val_args fun - ; return (is_exp, floats, App rhs' (Type ty)) } - go n_val_args (App fun arg) - = do { (is_exp, floats1, fun') <- go (n_val_args+1) fun - ; if is_exp - then do { (floats2, arg') <- makeTrivial env top_lvl topDmd occ arg - ; return (True, floats1 `addLetFlts` floats2, App fun' arg') } - else return (False, emptyLetFloats, App fun arg) - } - go n_val_args (Var fun) - = return (is_exp, emptyLetFloats, Var fun) - where - is_exp = isExpandableApp fun n_val_args -- The fun a constructor or PAP - -- See Note [CONLIKE pragma] in GHC.Types.Basic - -- The definition of is_exp should match that in - -- 'GHC.Core.Opt.OccurAnal.occAnalApp' - - go n_val_args (Tick t rhs) + -- We can' use exprIsExpandable because the WHOLE POINT is that + -- we want to treat (K ) as expandable, because we are just + -- about "anfise" the expression. exprIsExpandable would + -- just say no! + is_expandable = go rhs0 0 + where + go (Var fun) n_val_args = isExpandableApp fun n_val_args + go (App fun arg) n_val_args + | isTypeArg arg = go fun n_val_args + | otherwise = go fun (n_val_args + 1) + go (Cast rhs _) n_val_args = go rhs n_val_args + go (Tick _ rhs) n_val_args = go rhs n_val_args + go _ _ = False + + anfise :: OutExpr -> SimplM (LetFloats, OutExpr) + anfise (Cast rhs co) + = do { (floats, rhs') <- anfise rhs + ; return (floats, Cast rhs' co) } + anfise (App fun (Type ty)) + = do { (floats, rhs') <- anfise fun + ; return (floats, App rhs' (Type ty)) } + anfise (App fun arg) + = do { (floats1, fun') <- anfise fun + ; (floats2, arg') <- makeTrivial env top_lvl topDmd occ arg + ; return (floats1 `addLetFlts` floats2, App fun' arg') } + anfise (Var fun) + = return (emptyLetFloats, Var fun) + + anfise (Tick t rhs) -- We want to be able to float bindings past this -- tick. Non-scoping ticks don't care. | tickishScoped t == NoScope - = do { (is_exp, floats, rhs') <- go n_val_args rhs - ; return (is_exp, floats, Tick t rhs') } + = do { (floats, rhs') <- anfise rhs + ; return (floats, Tick t rhs') } -- On the other hand, for scoping ticks we need to be able to -- copy them on the floats, which in turn is only allowed if -- we can obtain non-counting ticks. | (not (tickishCounts t) || tickishCanSplit t) - = do { (is_exp, floats, rhs') <- go n_val_args rhs + = do { (floats, rhs') <- anfise rhs ; let tickIt (id, expr) = (id, mkTick (mkNoCount t) expr) floats' = mapLetFloats floats tickIt - ; return (is_exp, floats', Tick t rhs') } + ; return (floats', Tick t rhs') } - go _ other - = return (False, emptyLetFloats, other) + anfise other = return (emptyLetFloats, other) makeTrivialArg :: HasDebugCallStack => SimplEnv -> ArgSpec -> SimplM (LetFloats, ArgSpec) makeTrivialArg env arg@(ValArg { as_arg = e, as_dmd = dmd }) @@ -1244,7 +1246,7 @@ simplExprF1 env (Let (NonRec bndr rhs) body) cont | otherwise = {-#SCC "simplNonRecE" #-} - simplNonRecE env False bndr (rhs, env) body cont + simplNonRecE env FromLet bndr (rhs, env) body cont {- Note [Avoiding space leaks in OutType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1505,8 +1507,9 @@ rebuild env expr cont StrictArg { sc_fun = fun, sc_cont = cont, sc_fun_ty = fun_ty } -> rebuildCall env (addValArgTo fun expr fun_ty ) cont - StrictBind { sc_bndr = b, sc_body = body, sc_env = se, sc_cont = cont } - -> completeBindX (se `setInScopeFromE` env) b expr body cont + StrictBind { sc_bndr = b, sc_body = body, sc_env = se + , sc_cont = cont, sc_from = from_what } + -> completeBindX (se `setInScopeFromE` env) from_what b expr body cont ApplyToTy { sc_arg_ty = ty, sc_cont = cont} -> rebuild env (App expr (Type ty)) cont @@ -1518,25 +1521,48 @@ rebuild env expr cont ; rebuild env (App expr arg') cont } completeBindX :: SimplEnv + -> FromWhat -> InId -> OutExpr -- Bind this Id to this (simplified) expression -- (the let-can-float invariant may not be satisfied) - -> InExpr -- In this lambda + -> InExpr -- In this body -> SimplCont -- Consumed by this continuation -> SimplM (SimplFloats, OutExpr) -completeBindX env bndr rhs body cont - | needsCaseBinding (idType bndr) rhs -- Enforcing the let-can-float-invariant - = do { (env1, bndr1) <- simplNonRecBndr env bndr - ; (floats, expr') <- simplLam env1 body cont +completeBindX env from_what bndr rhs body cont + | FromBeta arg_ty <- from_what + , needsCaseBinding arg_ty rhs -- Enforcing the let-can-float-invariant + = do { (env1, bndr1) <- simplNonRecBndr env bndr -- Lambda binders don't have rules + ; (floats, expr') <- simplNonRecBody env1 from_what body cont -- Do not float floats past the Case binder below ; let expr'' = wrapFloats floats expr' - ; let case_expr = Case rhs bndr1 (contResultType cont) [Alt DEFAULT [] expr''] + case_expr = Case rhs bndr1 (contResultType cont) [Alt DEFAULT [] expr''] ; return (emptyFloats env, case_expr) } - | otherwise - = do { (floats1, env') <- simplNonRecX env bndr rhs - ; (floats2, expr') <- simplLam env' body cont - ; return (floats1 `addFloats` floats2, expr') } + | otherwise -- Make a let-binding + = do { (env1, bndr1) <- simplNonRecBndr env bndr + ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) + + ; let is_strict = isStrictId bndr2 + -- isStrictId: use simplified binder because the InId bndr might not have + -- a fixed runtime representation, which isStrictId doesn't expect + -- c.f. Note [Dark corner with representation polymorphism] + + ; (rhs_floats, rhs1) <- prepareBinding env NotTopLevel NonRecursive is_strict + bndr2 (emptyFloats env) rhs + -- NB: it makes a surprisingly big difference (5% in compiler allocation + -- in T9630) to pass 'env' rather than 'env1'. It's fine to pass 'env', + -- because this is simplNonRecX, so bndr is not in scope in the RHS. + + ; (bind_float, env2) <- completeBind (env2 `setInScopeFromF` rhs_floats) + (BC_Let NotTopLevel NonRecursive) + bndr bndr2 rhs1 + -- Must pass env1 to completeBind in case simplBinder had to clone, + -- and extended the substitution with [bndr :-> new_bndr] + + -- Simplify the body + ; (body_floats, body') <- simplNonRecBody env2 from_what body cont + ; let all_floats = rhs_floats `addFloats` bind_float `addFloats` body_floats + ; return ( all_floats, body' ) } {- ************************************************************************ @@ -1674,6 +1700,14 @@ simplArg env dup_flag fun_ty arg_env arg ************************************************************************ -} +simplNonRecBody :: SimplEnv -> FromWhat + -> InExpr -> SimplCont + -> SimplM (SimplFloats, OutExpr) +simplNonRecBody env from_what body cont + = case from_what of + FromLet -> simplExprF env body cont + FromBeta {} -> simplLam env body cont + simplLam :: SimplEnv -> InExpr -> SimplCont -> SimplM (SimplFloats, OutExpr) @@ -1690,15 +1724,24 @@ simpl_lam env bndr body (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = cont }) -- Value beta-reduction simpl_lam env bndr body (ApplyToVal { sc_arg = arg, sc_env = arg_se - , sc_cont = cont, sc_dup = dup }) - | isSimplified dup -- Don't re-simplify if we've simplified it once - -- See Note [Avoiding exponential behaviour] + , sc_cont = cont, sc_dup = dup + , sc_hole_ty = fun_ty}) = do { tick (BetaReduction bndr) - ; completeBindX env bndr arg body cont } + ; let arg_ty = funArgTy fun_ty + ; if | isSimplified dup -- Don't re-simplify if we've simplified it once + -- Including don't preInlineUnconditionally + -- See Note [Avoiding exponential behaviour] + -> completeBindX env (FromBeta arg_ty) bndr arg body cont + + | Just env' <- preInlineUnconditionally env NotTopLevel bndr arg arg_se + , not (needsCaseBinding arg_ty arg) + -- Ok to test arg::InExpr in needsCaseBinding because + -- exprOkForSpeculation is stable under simplification + -> do { tick (PreInlineUnconditionally bndr) + ; simplLam env' body cont } - | otherwise -- See Note [Avoiding exponential behaviour] - = do { tick (BetaReduction bndr) - ; simplNonRecE env True bndr (arg, arg_se) body cont } + | otherwise + -> simplNonRecE env (FromBeta arg_ty) bndr (arg, arg_se) body cont } -- Discard a non-counting tick on a lambda. This may change the -- cost attribution slightly (moving the allocation of the @@ -1730,8 +1773,7 @@ simplLamBndrs env bndrs = mapAccumLM simplLamBndr env bndrs ------------------ simplNonRecE :: SimplEnv - -> Bool -- True <=> from a lambda - -- False <=> from a let + -> FromWhat -> InId -- The binder, always an Id -- Never a join point -> (InExpr, SimplEnv) -- Rhs of binding (or arg of lambda) @@ -1740,56 +1782,48 @@ simplNonRecE :: SimplEnv -> SimplM (SimplFloats, OutExpr) -- simplNonRecE is used for --- * non-top-level non-recursive non-join-point lets in expressions --- * beta reduction +-- * from=FromLet: a non-top-level non-recursive non-join-point let-expression +-- * from=FromBeta: a binding arising from a beta reduction -- --- simplNonRec env b (rhs, rhs_se) body k +-- simplNonRecE env b (rhs, rhs_se) body k -- = let env in -- cont< let b = rhs_se(rhs) in body > -- -- It deals with strict bindings, via the StrictBind continuation, -- which may abort the whole process. -- --- from_lam=False => the RHS satisfies the let-can-float invariant +-- from_what=FromLet => the RHS satisfies the let-can-float invariant -- Otherwise it may or may not satisfy it. -simplNonRecE env from_lam bndr (rhs, rhs_se) body cont - = assert (isId bndr && not (isJoinId bndr) ) $ - do { (env1, bndr1) <- simplNonRecBndr env bndr - ; let needs_case_binding = needsCaseBinding (idType bndr1) rhs - -- See Note [Dark corner with representation polymorphism] - -- If from_lam=False then needs_case_binding is False, - -- because the binding started as a let, which must - -- satisfy let-can-float - - ; if | from_lam && not needs_case_binding - -- If not from_lam we are coming from a (NonRec bndr rhs) binding - -- and preInlineUnconditionally has been done already; - -- no need to repeat it. But for lambdas we must be careful about - -- preInlineUndonditionally: consider (\(x:Int#). 3) (error "urk") - -- We must not drop the (error "urk"). - , Just env' <- preInlineUnconditionally env NotTopLevel bndr rhs rhs_se - -> do { tick (PreInlineUnconditionally bndr) - ; -- pprTrace "preInlineUncond" (ppr bndr <+> ppr rhs) $ - simplLam env' body cont } - - -- Deal with strict bindings - | isStrictId bndr1 && seCaseCase env - || from_lam && needs_case_binding - -- The important bit here is needs_case_binds; but no need to - -- test it if from_lam is False because then needs_case_binding is False too - -- NB: either way, the RHS may or may not satisfy let-can-float - -- but that's ok for StrictBind. - -> simplExprF (rhs_se `setInScopeFromE` env) rhs - (StrictBind { sc_bndr = bndr, sc_body = body - , sc_env = env, sc_cont = cont, sc_dup = NoDup }) - - -- Deal with lazy bindings - | otherwise - -> do { (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) - ; (floats1, env3) <- simplLazyBind env2 NotTopLevel NonRecursive bndr bndr2 rhs rhs_se - ; (floats2, expr') <- simplLam env3 body cont - ; return (floats1 `addFloats` floats2, expr') } } +simplNonRecE env from_what bndr (rhs, rhs_se) body cont + | assert (isId bndr && not (isJoinId bndr) ) $ + is_strict_bind + = -- Evaluate RHS strictly + simplExprF (rhs_se `setInScopeFromE` env) rhs + (StrictBind { sc_bndr = bndr, sc_body = body, sc_from = from_what + , sc_env = env, sc_cont = cont, sc_dup = NoDup }) + + | otherwise -- Evaluate RHS lazily + = do { (env1, bndr1) <- simplNonRecBndr env bndr + ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) + ; (floats1, env3) <- simplLazyBind env2 NotTopLevel NonRecursive + bndr bndr2 rhs rhs_se + ; (floats2, expr') <- simplNonRecBody env3 from_what body cont + ; return (floats1 `addFloats` floats2, expr') } + + where + is_strict_bind = case from_what of + FromBeta arg_ty | isUnliftedType arg_ty -> True + -- If we are coming from a beta-reduction (FromBeta) we must + -- establish the let-can-float invariant, so go via StrictBind + -- If not, the invariant holds already, and it's optional. + -- Using arg_ty: see Note [Dark corner with representation polymorphism] + -- e.g (\r \(a::TYPE r) \(x::a). blah) @LiftedRep @Int arg + -- When we come to `x=arg` we myst choose lazy/strict correctly + -- It's wrong to err in either directly + + _ -> seCaseCase env && isStrUsedDmd (idDemandInfo bndr) + ------------------ simplRecE :: SimplEnv @@ -1835,7 +1869,7 @@ Note [Avoiding exponential behaviour] One way in which we can get exponential behaviour is if we simplify a big expression, and then re-simplify it -- and then this happens in a deeply-nested way. So we must be jolly careful about re-simplifying -an expression. That is why simplNonRecX does not try +an expression (#13379). That is why simplNonRecX does not try preInlineUnconditionally (unlike simplNonRecE). Example: @@ -2618,15 +2652,10 @@ Is this inefficient? Not really: we are about to walk over the result of the rule firing to simplify it, so occurrence analysis is at most a constant factor. -Possible improvement: occ-anal the rules when putting them in the -database; and in the simplifier just occ-anal the OutExpr arguments. -But that's more complicated and the rule RHS is usually tiny; so I'm -just doing the simple thing. - -Historical note: previously we did occ-anal the rules in Rule.hs, -but failed to occ-anal the OutExpr arguments, which led to the -nasty performance problem described above. - +Note, however, that the rule RHS is /already/ occ-analysed; see +Note [OccInfo in unfoldings and rules] in GHC.Core. There is something +unsatisfactory about doing it twice; but the rule RHS is usually very +small, and this is simple. Note [Optimising tagToEnum#] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2930,7 +2959,7 @@ rebuildCase env scrut case_bndr alts cont where simple_rhs env wfloats case_bndr_rhs bs rhs = assert (null bs) $ - do { (floats1, env') <- simplNonRecX env case_bndr case_bndr_rhs + do { (floats1, env') <- simplAuxBind env case_bndr case_bndr_rhs -- scrut is a constructor application, -- hence satisfies let-can-float invariant ; (floats2, expr') <- simplExprF env' rhs cont @@ -2997,7 +3026,7 @@ rebuildCase env scrut case_bndr alts@[Alt _ bndrs rhs] cont | all_dead_bndrs , doCaseToLet scrut case_bndr = do { tick (CaseElim case_bndr) - ; (floats1, env') <- simplNonRecX env case_bndr scrut + ; (floats1, env') <- simplAuxBind env case_bndr scrut ; (floats2, expr') <- simplExprF env' rhs cont ; return (floats1 `addFloats` floats2, expr') } @@ -3483,12 +3512,11 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont bind_args env' (b:bs') (arg : args) = assert (isId b) $ do { let b' = zap_occ b - -- Note that the binder might be "dead", because it doesn't - -- occur in the RHS; and simplNonRecX may therefore discard - -- it via postInlineUnconditionally. + -- zap_occ: the binder might be "dead", because it doesn't + -- occur in the RHS; and simplAuxBind may therefore discard it. -- Nevertheless we must keep it if the case-binder is alive, -- because it may be used in the con_app. See Note [knownCon occ info] - ; (floats1, env2) <- simplNonRecX env' b' arg -- arg satisfies let-can-float invariant + ; (floats1, env2) <- simplAuxBind env' b' arg -- arg satisfies let-can-float invariant ; (floats2, env3) <- bind_args env2 bs' args ; return (floats1 `addFloats` floats2, env3) } @@ -3514,7 +3542,7 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont ; let con_app = Var (dataConWorkId dc) `mkTyApps` dc_ty_args `mkApps` dc_args - ; simplNonRecX env bndr con_app } + ; simplAuxBind env bndr con_app } ------------------- missingAlt :: SimplEnv -> Id -> [InAlt] -> SimplCont @@ -3621,15 +3649,15 @@ mkDupableContWithDmds env dmds (TickIt t cont) ; return (floats, TickIt t cont') } mkDupableContWithDmds env _ - (StrictBind { sc_bndr = bndr, sc_body = body + (StrictBind { sc_bndr = bndr, sc_body = body, sc_from = from_what , sc_env = se, sc_cont = cont}) -- See Note [Duplicating StrictBind] -- K[ let x = <> in b ] --> join j x = K[ b ] -- j <> = do { let sb_env = se `setInScopeFromE` env ; (sb_env1, bndr') <- simplBinder sb_env bndr - ; (floats1, join_inner) <- simplLam sb_env1 body cont - -- No need to use mkDupableCont before simplLam; we + ; (floats1, join_inner) <- simplNonRecBody sb_env1 from_what body cont + -- No need to use mkDupableCont before simplNonRecBody; we -- use cont once here, and then share the result if necessary ; let join_body = wrapFloats floats1 join_inner @@ -3757,6 +3785,7 @@ mkDupableStrictBind env arg_bndr join_rhs res_ty , StrictBind { sc_bndr = arg_bndr , sc_body = join_rhs , sc_env = zapSubstEnv env + , sc_from = FromLet -- See Note [StaticEnv invariant] in GHC.Core.Opt.Simplify.Utils , sc_dup = OkToDup , sc_cont = mkBoringStop res_ty } ) @@ -4430,7 +4459,9 @@ simplRules env mb_new_id rules bind_cxt ; return (rule { ru_bndrs = bndrs' , ru_fn = fn_name' , ru_args = args' - , ru_rhs = rhs' }) } + , ru_rhs = occurAnalyseExpr rhs' }) } + -- Remember to occ-analyse, to drop dead code. + -- See Note [OccInfo in unfoldings and rules] in GHC.Core {- Note [Simplifying the RHS of a RULE] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -21,7 +21,7 @@ module GHC.Core.Opt.Simplify.Utils ( BindContext(..), bindContextLevel, -- The continuation type - SimplCont(..), DupFlag(..), StaticEnv, + SimplCont(..), DupFlag(..), FromWhat(..), StaticEnv, isSimplified, contIsStop, contIsDupable, contResultType, contHoleType, contHoleScaling, contIsTrivial, contArgs, contIsRhs, @@ -192,6 +192,7 @@ data SimplCont -- or, equivalently, = K[ (\x.b) e ] { sc_dup :: DupFlag -- See Note [DupFlag invariants] , sc_bndr :: InId + , sc_from :: FromWhat , sc_body :: InExpr , sc_env :: StaticEnv -- See Note [StaticEnv invariant] , sc_cont :: SimplCont } @@ -213,6 +214,8 @@ data SimplCont type StaticEnv = SimplEnv -- Just the static part is relevant +data FromWhat = FromLet | FromBeta OutType + -- See Note [DupFlag invariants] data DupFlag = NoDup -- Unsimplified, might be big | Simplified -- Simplified ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -63,6 +63,7 @@ import GHC.Core.Tidy ( tidyRules ) import GHC.Core.Map.Expr ( eqCoreExpr ) import GHC.Core.Opt.Arity( etaExpandToJoinPointRule ) import GHC.Core.Make ( mkCoreLams ) +import GHC.Core.Opt.OccurAnal( occurAnalyseExpr ) import GHC.Tc.Utils.TcType ( tcSplitTyConApp_maybe ) import GHC.Builtin.Types ( anyTypeOfKind ) @@ -189,13 +190,18 @@ mkRule :: Module -> Bool -> Bool -> RuleName -> Activation -- ^ Used to make 'CoreRule' for an 'Id' defined in the module being -- compiled. See also 'GHC.Core.CoreRule' mkRule this_mod is_auto is_local name act fn bndrs args rhs - = Rule { ru_name = name, ru_fn = fn, ru_act = act, - ru_bndrs = bndrs, ru_args = args, - ru_rhs = rhs, - ru_rough = roughTopNames args, - ru_origin = this_mod, - ru_orphan = orph, - ru_auto = is_auto, ru_local = is_local } + = Rule { ru_name = name + , ru_act = act + , ru_fn = fn + , ru_bndrs = bndrs + , ru_args = args + , ru_rhs = occurAnalyseExpr rhs + -- See Note [OccInfo in unfoldings and rules] + , ru_rough = roughTopNames args + , ru_origin = this_mod + , ru_orphan = orph + , ru_auto = is_auto + , ru_local = is_local } where -- Compute orphanhood. See Note [Orphans] in GHC.Core.InstEnv -- A rule is an orphan only if none of the variables ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -513,8 +513,8 @@ bindNonRec bndr rhs body -- | Tests whether we have to use a @case@ rather than @let@ binding for this -- expression as per the invariants of 'CoreExpr': see "GHC.Core#let_can_float_invariant" needsCaseBinding :: Type -> CoreExpr -> Bool -needsCaseBinding ty rhs = - mightBeUnliftedType ty && not (exprOkForSpeculation rhs) +needsCaseBinding ty rhs + = mightBeUnliftedType ty && not (exprOkForSpeculation rhs) -- Make a case expression instead of a let -- These can arise either from the desugarer, -- or from beta reductions: (\x.e) (x +# y) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -517,6 +517,12 @@ data DynFlags = DynFlags { reductionDepth :: IntWithInf, -- ^ Typechecker maximum stack depth solverIterations :: IntWithInf, -- ^ Number of iterations in the constraints solver -- Typically only 1 is needed + givensFuel :: Int, -- ^ Number of layers of superclass expansion + -- Should be < solverIterations + wantedsFuel :: Int, -- ^ Number of layers of superclass expansion + -- Should be < givensFuel + qcsFuel :: Int, -- ^ Number of layers of superclass expansion + -- Should be < givensFuel homeUnitId_ :: UnitId, -- ^ Target home unit-id homeUnitInstanceOf_ :: Maybe UnitId, -- ^ Id of the unit to instantiate @@ -1148,6 +1154,9 @@ defaultDynFlags mySettings = mainFunIs = Nothing, reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH, solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS, + givensFuel = mAX_GIVENS_FUEL, + wantedsFuel = mAX_WANTEDS_FUEL, + qcsFuel = mAX_QC_FUEL, homeUnitId_ = mainUnitId, homeUnitInstanceOf_ = Nothing, @@ -2732,6 +2741,12 @@ dynamic_flags_deps = [ (intSuffix (\n d -> d { reductionDepth = treatZeroAsInf n })) , make_ord_flag defFlag "fconstraint-solver-iterations" (intSuffix (\n d -> d { solverIterations = treatZeroAsInf n })) + , make_ord_flag defFlag "fgivens-expansion-fuel" + (intSuffix (\n d -> d { givensFuel = n })) + , make_ord_flag defFlag "fwanteds-expansion-fuel" + (intSuffix (\n d -> d { wantedsFuel = n })) + , make_ord_flag defFlag "fqcs-expansion-fuel" + (intSuffix (\n d -> d { qcsFuel = n })) , (Deprecated, defFlag "fcontext-stack" (intSuffixM (\n d -> do { deprecate $ "use -freduction-depth=" ++ show n ++ " instead" @@ -4939,6 +4954,7 @@ needSourceNotes dflags = debugLevel dflags > 0 -- LinkerInfo contains any extra options needed by the system linker. data LinkerInfo = GnuLD [Option] + | Mold [Option] | GnuGold [Option] | LlvmLLD [Option] | DarwinLD [Option] ===================================== compiler/GHC/Settings/Constants.hs ===================================== @@ -30,6 +30,21 @@ mAX_REDUCTION_DEPTH = 200 mAX_SOLVER_ITERATIONS :: Int mAX_SOLVER_ITERATIONS = 4 +-- | In case of loopy quantified costraints constraints, +-- how many times should we allow superclass expansions +mAX_QC_FUEL :: Int +mAX_QC_FUEL = 3 + +-- | In case of loopy wanted constraints, +-- how many times should we allow superclass expansions +mAX_WANTEDS_FUEL :: Int +mAX_WANTEDS_FUEL = 1 + +-- | In case of loopy given constraints, +-- how many times should we allow superclass expansions +mAX_GIVENS_FUEL :: Int +mAX_GIVENS_FUEL = 3 + wORD64_SIZE :: Int wORD64_SIZE = 8 ===================================== compiler/GHC/SysTools/Info.hs ===================================== @@ -70,6 +70,7 @@ The flag is only needed on ELF systems. On Windows (PE) and Mac OS X neededLinkArgs :: LinkerInfo -> [Option] neededLinkArgs (GnuLD o) = o +neededLinkArgs (Mold o) = o neededLinkArgs (GnuGold o) = o neededLinkArgs (LlvmLLD o) = o neededLinkArgs (DarwinLD o) = o @@ -106,6 +107,10 @@ getLinkerInfo' logger dflags = do -- see Note [ELF needed shared libs] "-Wl,--no-as-needed"]) + | any ("mold" `isPrefixOf`) stdo = + return (Mold $ map Option [ --see Note [ELF needed shared libs] + "-Wl,--no-as-needed"]) + | any ("GNU gold" `isPrefixOf`) stdo = -- GNU gold only needs --no-as-needed. #10110. -- ELF specific flag, see Note [ELF needed shared libs] ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -2338,6 +2338,10 @@ maybe_simplify_again n limit unif_happened wc@(WC { wc_simple = simples }) do { new_given <- makeSuperClasses pending_given ; new_wanted <- makeSuperClasses pending_wanted ; solveSimpleGivens new_given -- Add the new Givens to the inert set + ; traceTcS "maybe_simplify_again" (vcat [ text "pending_given" <+> ppr pending_given + , text "new_given" <+> ppr new_given + , text "pending_wanted" <+> ppr pending_wanted + , text "new_wanted" <+> ppr new_wanted ]) ; simplify_loop n limit (not (null pending_given)) $ wc { wc_simple = simples1 `unionBags` listToBag new_wanted } } } -- (not (null pending_given)): see Note [Superclass iteration] @@ -2366,6 +2370,43 @@ superclasses. In that case we check whether the new Wanteds actually led to any new unifications, and iterate the implications only if so. -} +{- Note [SimplifyInfer with UndecidableSuperClasses] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In some cases while infering the type of a term well typed term, it is necessary to ensure +we limit the wanted superclass expansions. +Expanding them too many times will lead to the given constraint superclass expansion +not being able solve all the wanted constraints, by entering a perpetual loop and erroring out on +too many solver iterations. Expanding them too little will not give us a simplified type signature. + +Consider the program (T21909) + + class C [a] => C a where + foo :: a -> Int + + bar :: C a => a -> Int + bar x = foolocal x + where + foolocal x = foo x + +In the current implimentation +We infer the type of foolocal to be `(C a) => a -> Int` +and then simplify it to `(C a, C [[a]]) => a -> Int` + +This indeed is not simplification per say, but we are in UndecidableSuperclass case +so we cannot guarantee simplification of contraints. What we aim for is for the +the solver to not to loop unnecessarily generating more wanted constraints than +in can solve in `maybe_simplify_again`. + +If we did not limit the wanteds superclass expansion we would simplify the type signature of +foolocal as `(C a , C [[a]], C[[[[a]]]], C[[[[a]]]], C [[[[[[[[a]]]]]]]]) => a -> Int` +Definitely _worse_ than above type! + +The current limit the expansion of such recursive wanted constraints to 1 (mAX_WANTEDS_FUEL), +and limit the expansion of recursive given constraints to 3 (mAX_GIVENS_FUEL). + +-} + + solveNestedImplications :: Bag Implication -> TcS (Bag Implication) -- Precondition: the TcS inerts may contain unsolved simples which have ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -58,7 +58,7 @@ import Control.Monad import Data.Maybe ( isJust, isNothing ) import Data.List ( zip4 ) import GHC.Types.Basic - +import GHC.Driver.Session ( DynFlags, givensFuel, wantedsFuel, qcsFuel ) import qualified Data.Semigroup as S import Data.Bifunctor ( bimap ) @@ -127,14 +127,16 @@ canonicalize (CEqCan { cc_ev = ev canNC :: CtEvidence -> TcS (StopOrContinue Ct) canNC ev = case classifyPredType pred of - ClassPred cls tys -> do traceTcS "canEvNC:cls" (ppr cls <+> ppr tys) - canClassNC ev cls tys + ClassPred cls tys -> do dflags <- getDynFlags + traceTcS "canEvNC:cls" (ppr cls <+> ppr tys) + canClassNC dflags ev cls tys EqPred eq_rel ty1 ty2 -> do traceTcS "canEvNC:eq" (ppr ty1 $$ ppr ty2) canEqNC ev eq_rel ty1 ty2 IrredPred {} -> do traceTcS "canEvNC:irred" (ppr pred) canIrred ev - ForAllPred tvs th p -> do traceTcS "canEvNC:forall" (ppr pred) - canForAllNC ev tvs th p + ForAllPred tvs th p -> do dflags <- getDynFlags + traceTcS "canEvNC:forall" (ppr pred) + canForAllNC dflags ev tvs th p where pred = ctEvPred ev @@ -147,15 +149,16 @@ canNC ev = ************************************************************************ -} -canClassNC :: CtEvidence -> Class -> [Type] -> TcS (StopOrContinue Ct) +canClassNC :: DynFlags -> CtEvidence -> Class -> [Type] -> TcS (StopOrContinue Ct) -- "NC" means "non-canonical"; that is, we have got here -- from a NonCanonical constraint, not from a CDictCan -- Precondition: EvVar is class evidence -canClassNC ev cls tys +canClassNC dflags ev cls tys | isGiven ev -- See Note [Eagerly expand given superclasses] - = do { sc_cts <- mkStrictSuperClasses ev [] [] cls tys + = do { let gf = givensFuel dflags + ; sc_cts <- mkStrictSuperClasses gf ev [] [] cls tys ; emitWork sc_cts - ; canClass ev cls tys False } + ; canClass ev cls tys doNotExpand } | CtWanted { ctev_rewriters = rewriters } <- ev , Just ip_name <- isCallStackPred cls tys @@ -181,14 +184,16 @@ canClassNC ev cls tys (ctLocSpan loc) (ctEvExpr new_ev) ; solveCallStack ev ev_cs - ; canClass new_ev cls tys False -- No superclasses + ; canClass new_ev cls tys doNotExpand -- No superclasses } | otherwise - = canClass ev cls tys (has_scs cls) + = canClass ev cls tys fuel where - has_scs cls = not (null (classSCTheta cls)) + fuel | cls_has_scs = wantedsFuel dflags + | otherwise = doNotExpand + cls_has_scs = not (null (classSCTheta cls)) loc = ctEvLoc ev orig = ctLocOrigin loc pred = ctEvPred ev @@ -205,7 +210,7 @@ solveCallStack ev ev_cs = do canClass :: CtEvidence -> Class -> [Type] - -> Bool -- True <=> un-explored superclasses + -> ExpansionFuel -- n > 0 <=> un-explored superclasses -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence @@ -492,39 +497,40 @@ makeSuperClasses :: [Ct] -> TcS [Ct] -- class C [a] => D a -- makeSuperClasses (C x) will return (D x, C [x]) -- --- NB: the incoming constraints have had their cc_pend_sc flag already --- flipped to False, by isPendingScDict, so we are /obliged/ to at --- least produce the immediate superclasses +-- NB: the incoming constraints will be expanded only if the fuel is striclty > 0 +-- expansion will consume a unit of fuel makeSuperClasses cts = concatMapM go cts where - go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys }) - = mkStrictSuperClasses ev [] [] cls tys - go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev })) + go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys, cc_pend_sc = fuel }) + = assertPpr (fuel > 0) (ppr cls) $ -- fuel needs to be more than 0 always + mkStrictSuperClasses (consumeFuel fuel) ev [] [] cls tys + go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev, qci_pend_sc = fuel })) = assertPpr (isClassPred pred) (ppr pred) $ -- The cts should all have -- class pred heads - mkStrictSuperClasses ev tvs theta cls tys + assertPpr (fuel > 0) (ppr cls) $ -- fuel needs to be more than 0 always + mkStrictSuperClasses (consumeFuel fuel) ev tvs theta cls tys where (tvs, theta, cls, tys) = tcSplitDFunTy (ctEvPred ev) go ct = pprPanic "makeSuperClasses" (ppr ct) mkStrictSuperClasses - :: CtEvidence + :: ExpansionFuel -> CtEvidence -> [TyVar] -> ThetaType -- These two args are non-empty only when taking -- superclasses of a /quantified/ constraint -> Class -> [Type] -> TcS [Ct] -- Return constraints for the strict superclasses of -- ev :: forall as. theta => cls tys -mkStrictSuperClasses ev tvs theta cls tys - = mk_strict_superclasses (unitNameSet (className cls)) +mkStrictSuperClasses fuel ev tvs theta cls tys + = mk_strict_superclasses fuel (unitNameSet (className cls)) ev tvs theta cls tys -mk_strict_superclasses :: NameSet -> CtEvidence +mk_strict_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return the immediate superclasses of (cls tys); -- and expand their superclasses, provided none of them are in rec_clss -- nor are repeated -mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) +mk_strict_superclasses fuel rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) tvs theta cls tys = concatMapM do_one_given $ classSCSelIds cls @@ -542,7 +548,7 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) | otherwise = do { given_ev <- newGivenEvVar sc_loc $ mk_given_desc sel_id sc_pred - ; mk_superclasses rec_clss given_ev tvs theta sc_pred } + ; mk_superclasses fuel rec_clss given_ev tvs theta sc_pred } where sc_pred = classMethodInstTy sel_id tys @@ -603,7 +609,7 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) newly_blocked (InstSkol _ head_size) = isJust (this_size `ltPatersonSize` head_size) newly_blocked _ = False -mk_strict_superclasses rec_clss ev tvs theta cls tys +mk_strict_superclasses fuel rec_clss ev tvs theta cls tys | all noFreeVarsOfType tys = return [] -- Wanteds with no variables yield no superclass constraints. -- See Note [Improvement from Ground Wanteds] @@ -618,7 +624,7 @@ mk_strict_superclasses rec_clss ev tvs theta cls tys do_one sc_pred = do { traceTcS "mk_strict_superclasses Wanted" (ppr (mkClassPred cls tys) $$ ppr sc_pred) ; sc_ev <- newWantedNC loc (ctEvRewriters ev) sc_pred - ; mk_superclasses rec_clss sc_ev [] [] sc_pred } + ; mk_superclasses fuel rec_clss sc_ev [] [] sc_pred } {- Note [Improvement from Ground Wanteds] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -633,46 +639,49 @@ dependencies. See Note [Why adding superclasses can help] above. But no variables means no improvement; case closed. -} -mk_superclasses :: NameSet -> CtEvidence +mk_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> PredType -> TcS [Ct] -- Return this constraint, plus its superclasses, if any -mk_superclasses rec_clss ev tvs theta pred +mk_superclasses fuel rec_clss ev tvs theta pred | ClassPred cls tys <- classifyPredType pred - = mk_superclasses_of rec_clss ev tvs theta cls tys + = mk_superclasses_of fuel rec_clss ev tvs theta cls tys | otherwise -- Superclass is not a class predicate = return [mkNonCanonical ev] -mk_superclasses_of :: NameSet -> CtEvidence +mk_superclasses_of :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return this class constraint, -- and expand its superclasses -mk_superclasses_of rec_clss ev tvs theta cls tys +mk_superclasses_of fuel rec_clss ev tvs theta cls tys | loop_found = do { traceTcS "mk_superclasses_of: loop" (ppr cls <+> ppr tys) - ; return [this_ct] } -- cc_pend_sc of this_ct = True + ; return [this_ct] } -- cc_pend_sc of this_ct = fuel | otherwise = do { traceTcS "mk_superclasses_of" (vcat [ ppr cls <+> ppr tys , ppr (isCTupleClass cls) , ppr rec_clss ]) - ; sc_cts <- mk_strict_superclasses rec_clss' ev tvs theta cls tys + ; sc_cts <- mk_strict_superclasses fuel rec_clss' ev tvs theta cls tys ; return (this_ct : sc_cts) } - -- cc_pend_sc of this_ct = False + -- cc_pend_sc of this_ct = doNotExpand where cls_nm = className cls loop_found = not (isCTupleClass cls) && cls_nm `elemNameSet` rec_clss -- Tuples never contribute to recursion, and can be nested rec_clss' = rec_clss `extendNameSet` cls_nm + this_cc_pend | loop_found = fuel + | otherwise = 0 + this_ct | null tvs, null theta = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys - , cc_pend_sc = loop_found } + , cc_pend_sc = this_cc_pend } -- NB: If there is a loop, we cut off, so we have not -- added the superclasses, hence cc_pend_sc = True | otherwise = CQuantCan (QCI { qci_tvs = tvs, qci_pred = mkClassPred cls tys , qci_ev = ev - , qci_pend_sc = loop_found }) + , qci_pend_sc = this_cc_pend }) {- Note [Equality superclasses in quantified constraints] @@ -723,6 +732,7 @@ canIrred :: CtEvidence -> TcS (StopOrContinue Ct) -- Precondition: ty not a tuple and no other evidence form canIrred ev = do { let pred = ctEvPred ev + ; dflags <- getDynFlags ; traceTcS "can_pred" (text "IrredPred = " <+> ppr pred) ; (redn, rewriters) <- rewrite ev pred ; rewriteEvidence rewriters ev redn `andWhenContinue` \ new_ev -> @@ -731,7 +741,7 @@ canIrred ev -- Code is like the canNC, except -- that the IrredPred branch stops work ; case classifyPredType (ctEvPred new_ev) of - ClassPred cls tys -> canClassNC new_ev cls tys + ClassPred cls tys -> canClassNC dflags new_ev cls tys EqPred eq_rel ty1 ty2 -> -- IrredPreds have kind Constraint, so -- cannot become EqPreds pprPanic "canIrred: EqPred" @@ -740,7 +750,7 @@ canIrred ev -- should never leave a meta-var filled -- in with a polytype. This is #18987. do traceTcS "canEvNC:forall" (ppr pred) - canForAllNC ev tvs th p + canForAllNC dflags ev tvs th p IrredPred {} -> continueWith $ mkIrredCt IrredShapeReason new_ev } } @@ -822,24 +832,28 @@ type signature. -} -canForAllNC :: CtEvidence -> [TyVar] -> TcThetaType -> TcPredType +canForAllNC :: DynFlags -> CtEvidence -> [TyVar] -> TcThetaType -> TcPredType -> TcS (StopOrContinue Ct) -canForAllNC ev tvs theta pred +canForAllNC dflags ev tvs theta pred | isGiven ev -- See Note [Eagerly expand given superclasses] , Just (cls, tys) <- cls_pred_tys_maybe - = do { sc_cts <- mkStrictSuperClasses ev tvs theta cls tys + = do { let gf = givensFuel dflags + ; sc_cts <- mkStrictSuperClasses gf ev tvs theta cls tys ; emitWork sc_cts - ; canForAll ev False } + ; canForAll ev doNotExpand } | otherwise - = canForAll ev (isJust cls_pred_tys_maybe) + = do { let qcf = qcsFuel dflags + fuel | isJust cls_pred_tys_maybe = qcf + | otherwise = doNotExpand + ; canForAll ev fuel } where cls_pred_tys_maybe = getClassPredTys_maybe pred -canForAll :: CtEvidence -> Bool -> TcS (StopOrContinue Ct) +canForAll :: CtEvidence -> ExpansionFuel -> TcS (StopOrContinue Ct) -- We have a constraint (forall as. blah => C tys) -canForAll ev pend_sc +canForAll ev fuel = do { -- First rewrite it to apply the current substitution let pred = ctEvPred ev ; (redn, rewriters) <- rewrite ev pred @@ -849,14 +863,14 @@ canForAll ev pend_sc -- (It takes a lot less code to rewrite before decomposing.) ; case classifyPredType (ctEvPred new_ev) of ForAllPred tvs theta pred - -> solveForAll new_ev tvs theta pred pend_sc + -> solveForAll new_ev tvs theta pred fuel _ -> pprPanic "canForAll" (ppr new_ev) } } -solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> Bool +solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> ExpansionFuel -> TcS (StopOrContinue Ct) solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_loc = loc }) - tvs theta pred _pend_sc + tvs theta pred _fuel = -- See Note [Solving a Wanted forall-constraint] setLclEnv (ctLocEnv loc) $ -- This setLclEnv is important: the emitImplicationTcS uses that @@ -902,12 +916,12 @@ solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_lo _ -> pSizeType pred -- See Note [Solving a Given forall-constraint] -solveForAll ev@(CtGiven {}) tvs _theta pred pend_sc +solveForAll ev@(CtGiven {}) tvs _theta pred fuel = do { addInertForAll qci ; stopWith ev "Given forall-constraint" } where qci = QCI { qci_ev = ev, qci_tvs = tvs - , qci_pred = pred, qci_pend_sc = pend_sc } + , qci_pred = pred, qci_pend_sc = fuel } {- Note [Solving a Wanted forall-constraint] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -513,10 +513,13 @@ getInertGivens ; return (filter isGivenCt all_cts) } getPendingGivenScs :: TcS [Ct] --- Find all inert Given dictionaries, or quantified constraints, --- whose cc_pend_sc flag is True --- and that belong to the current level --- Set their cc_pend_sc flag to False in the inert set, and return that Ct +-- Find all inert Given dictionaries, or quantified constraints, such that +-- 1. cc_pend_sc flag has fuel strictly > 0 +-- 2. belongs to the current level +-- For each such dictionary: +-- * Return it (with unmodified cc_pend_sc) in sc_pending +-- * Modify the dict in the inert set to have cc_pend_sc = doNotExpand +-- to record that we have expanded superclasses for this dict getPendingGivenScs = do { lvl <- getTcLevel ; updRetInertCans (get_sc_pending lvl) } @@ -530,29 +533,33 @@ get_sc_pending this_lvl ic@(IC { inert_dicts = dicts, inert_insts = insts }) sc_pending = sc_pend_insts ++ sc_pend_dicts sc_pend_dicts = foldDicts get_pending dicts [] - dicts' = foldr add dicts sc_pend_dicts + dicts' = foldr exhaustAndAdd dicts sc_pend_dicts (sc_pend_insts, insts') = mapAccumL get_pending_inst [] insts - get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc = True - -- but flipping the flag + get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc > 0 get_pending dict dicts - | Just dict' <- pendingScDict_maybe dict + | isPendingScDict dict , belongs_to_this_level (ctEvidence dict) - = dict' : dicts + = dict : dicts | otherwise = dicts - add :: Ct -> DictMap Ct -> DictMap Ct - add ct@(CDictCan { cc_class = cls, cc_tyargs = tys }) dicts - = addDict dicts cls tys ct - add ct _ = pprPanic "getPendingScDicts" (ppr ct) + exhaustAndAdd :: Ct -> DictMap Ct -> DictMap Ct + exhaustAndAdd ct@(CDictCan { cc_class = cls, cc_tyargs = tys }) dicts + -- exhaust the fuel for this constraint before adding it as + -- we don't want to expand these constraints again + = addDict dicts cls tys (ct {cc_pend_sc = doNotExpand}) + exhaustAndAdd ct _ = pprPanic "getPendingScDicts" (ppr ct) get_pending_inst :: [Ct] -> QCInst -> ([Ct], QCInst) get_pending_inst cts qci@(QCI { qci_ev = ev }) | Just qci' <- pendingScInst_maybe qci , belongs_to_this_level ev - = (CQuantCan qci' : cts, qci') + = (CQuantCan qci : cts, qci') + -- qci' have their fuel exhausted + -- we don't want to expand these constraints again + -- qci is expanded | otherwise = (cts, qci) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -11,6 +11,7 @@ module GHC.Tc.Types.Constraint ( -- Canonical constraints Xi, Ct(..), Cts, + ExpansionFuel, doNotExpand, consumeFuel, emptyCts, andCts, andManyCts, pprCts, singleCt, listToCts, ctsElts, consCts, snocCts, extendCtsList, isEmptyCts, @@ -138,8 +139,6 @@ import Data.Word ( Word8 ) import Data.List ( intersperse ) - - {- ************************************************************************ * * @@ -191,6 +190,16 @@ type Xi = TcType type Cts = Bag Ct +-- | Says how many layers of superclasses can we expand. +-- see Note [SimplifyInfer with UndecidableSuperClasses] +type ExpansionFuel = Int + +doNotExpand :: ExpansionFuel -- Do not expand superclasses anymore +doNotExpand = 0 + +consumeFuel :: ExpansionFuel -> ExpansionFuel +consumeFuel fuel = fuel - 1 + data Ct -- Atomic canonical constraints = CDictCan { -- e.g. Num ty @@ -199,11 +208,11 @@ data Ct cc_class :: Class, cc_tyargs :: [Xi], -- cc_tyargs are rewritten w.r.t. inerts, so Xi - cc_pend_sc :: Bool + cc_pend_sc :: ExpansionFuel -- See Note [The superclass story] in GHC.Tc.Solver.Canonical - -- True <=> (a) cc_class has superclasses - -- (b) we have not (yet) added those - -- superclasses as Givens + -- See Note [SimplifyInfer with UndecidableSuperClasses] in GHC.Tc.Solver + -- n > 0 <=> (a) cc_class has superclasses + -- (b) we have not (yet) explored those superclasses } | CIrredCan { -- These stand for yet-unusable predicates @@ -273,8 +282,11 @@ data QCInst -- A much simplified version of ClsInst -- Always Given , qci_tvs :: [TcTyVar] -- The tvs , qci_pred :: TcPredType -- The ty - , qci_pend_sc :: Bool -- Same as cc_pend_sc flag in CDictCan - -- Invariant: True => qci_pred is a ClassPred + , qci_pend_sc :: ExpansionFuel -- Invariants: qci_pend_sc > 0 => qci_pred is a ClassPred + -- and the superclasses are unexplored + -- Same as cc_pend_sc flag in CDictCan + -- See Note [SimplifyInfer with UndecidableSuperClasses] + -- in GHC.Tc.Solver } instance Outputable QCInst where @@ -673,11 +685,11 @@ instance Outputable Ct where CEqCan {} -> text "CEqCan" CNonCanonical {} -> text "CNonCanonical" CDictCan { cc_pend_sc = psc } - | psc -> text "CDictCan(psc)" - | otherwise -> text "CDictCan" + | psc > 0 -> text "CDictCan" <> parens (text "psc" <+> ppr psc) + | otherwise -> text "CDictCan" CIrredCan { cc_reason = reason } -> text "CIrredCan" <> ppr reason - CQuantCan (QCI { qci_pend_sc = pend_sc }) - | pend_sc -> text "CQuantCan(psc)" + CQuantCan (QCI { qci_pend_sc = psc }) + | psc > 0 -> text "CQuantCan" <> parens (text "psc" <+> ppr psc) | otherwise -> text "CQuantCan" ----------------------------------- @@ -893,23 +905,24 @@ isUserTypeError pred = case getUserTypeErrorMsg pred of _ -> False isPendingScDict :: Ct -> Bool -isPendingScDict (CDictCan { cc_pend_sc = psc }) = psc --- Says whether this is a CDictCan with cc_pend_sc is True; +isPendingScDict (CDictCan { cc_pend_sc = psc }) = psc > 0 +-- Says whether this is a CDictCan with cc_pend_sc has positive fuel; -- i.e. pending un-expanded superclasses isPendingScDict _ = False pendingScDict_maybe :: Ct -> Maybe Ct --- Says whether this is a CDictCan with cc_pend_sc is True, --- AND if so flips the flag -pendingScDict_maybe ct@(CDictCan { cc_pend_sc = True }) - = Just (ct { cc_pend_sc = False }) +-- Says whether this is a CDictCan with cc_pend_sc has fuel left, +-- AND if so exhausts the fuel so that they are not expanded again +pendingScDict_maybe ct@(CDictCan { cc_pend_sc = n }) + | n > 0 = Just (ct { cc_pend_sc = doNotExpand }) + | otherwise = Nothing pendingScDict_maybe _ = Nothing pendingScInst_maybe :: QCInst -> Maybe QCInst -- Same as isPendingScDict, but for QCInsts -pendingScInst_maybe qci@(QCI { qci_pend_sc = True }) - = Just (qci { qci_pend_sc = False }) -pendingScInst_maybe _ = Nothing +pendingScInst_maybe qci@(QCI { qci_pend_sc = n }) + | n > 0 = Just (qci { qci_pend_sc = doNotExpand }) + | otherwise = Nothing superClassesMightHelp :: WantedConstraints -> Bool -- ^ True if taking superclasses of givens, or of wanteds (to perhaps @@ -928,11 +941,12 @@ superClassesMightHelp (WC { wc_simple = simples, wc_impl = implics }) is_ip _ = False getPendingWantedScs :: Cts -> ([Ct], Cts) +-- in the return values [Ct] has original fuel while Cts has fuel exhausted getPendingWantedScs simples = mapAccumBagL get [] simples where - get acc ct | Just ct' <- pendingScDict_maybe ct - = (ct':acc, ct') + get acc ct | Just ct_exhausted <- pendingScDict_maybe ct + = (ct:acc, ct_exhausted) | otherwise = (acc, ct) ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -723,12 +723,14 @@ setIdCprSig id sig = modifyIdInfo (\info -> setCprSigInfo info sig) id zapIdDmdSig :: Id -> Id zapIdDmdSig id = modifyIdInfo (`setDmdSigInfo` nopSig) id --- | This predicate says whether the 'Id' has a strict demand placed on it or --- has a type such that it can always be evaluated strictly (i.e an --- unlifted type, as of GHC 7.6). We need to --- check separately whether the 'Id' has a so-called \"strict type\" because if --- the demand for the given @id@ hasn't been computed yet but @id@ has a strict --- type, we still want @isStrictId id@ to be @True at . +-- | `isStrictId` says whether either +-- (a) the 'Id' has a strict demand placed on it or +-- (b) definitely has a \"strict type\", such that it can always be +-- evaluated strictly (i.e an unlifted type) +-- We need to check (b) as well as (a), because when the demand for the +-- given `id` hasn't been computed yet but `id` has a strict +-- type, we still want `isStrictId id` to be `True`. +-- Returns False if the type is levity polymorphic; False is always safe. isStrictId :: Id -> Bool isStrictId id | assertPpr (isId id) (text "isStrictId: not an id: " <+> ppr id) $ ===================================== compiler/GHC/Unit/Module/ModIface.hs ===================================== @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE NamedFieldPuns #-} module GHC.Unit.Module.ModIface ( ModIface @@ -549,20 +550,58 @@ emptyIfaceHashCache _occ = Nothing -- Take care, this instance only forces to the degree necessary to -- avoid major space leaks. -instance (NFData (IfaceBackendExts (phase :: ModIfacePhase)), NFData (IfaceDeclExts (phase :: ModIfacePhase))) => NFData (ModIface_ phase) where - rnf (ModIface f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 - f13 f14 f15 f16 f17 f18 f19 f20 f21 f22 f23 f24) = - rnf f1 `seq` rnf f2 `seq` f3 `seq` f4 `seq` f5 `seq` f6 `seq` rnf f7 `seq` f8 `seq` - f9 `seq` rnf f10 `seq` rnf f11 `seq` rnf f12 `seq` f13 `seq` rnf f14 `seq` rnf f15 `seq` rnf f16 `seq` - rnf f17 `seq` f18 `seq` rnf f19 `seq` rnf f20 `seq` rnf f21 `seq` f22 `seq` f23 `seq` rnf f24 +instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase)) + , NFData (IfaceDeclExts (phase :: ModIfacePhase)) + ) => NFData (ModIface_ phase) where + rnf (ModIface{ mi_module, mi_sig_of, mi_hsc_src, mi_deps, mi_usages + , mi_exports, mi_used_th, mi_fixities, mi_warns, mi_anns + , mi_decls, mi_extra_decls, mi_globals, mi_insts + , mi_fam_insts, mi_rules, mi_hpc, mi_trust, mi_trust_pkg + , mi_complete_matches, mi_docs, mi_final_exts + , mi_ext_fields, mi_src_hash}) + = rnf mi_module + `seq` rnf mi_sig_of + `seq` mi_hsc_src + `seq` mi_deps + `seq` mi_usages + `seq` mi_exports + `seq` rnf mi_used_th + `seq` mi_fixities + `seq` mi_warns + `seq` rnf mi_anns + `seq` rnf mi_decls + `seq` rnf mi_extra_decls + `seq` mi_globals + `seq` rnf mi_insts + `seq` rnf mi_fam_insts + `seq` rnf mi_rules + `seq` rnf mi_hpc + `seq` mi_trust + `seq` rnf mi_trust_pkg + `seq` rnf mi_complete_matches + `seq` rnf mi_docs + `seq` mi_final_exts + `seq` mi_ext_fields + `seq` rnf mi_src_hash `seq` () - instance NFData (ModIfaceBackend) where - rnf (ModIfaceBackend f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13) - = rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` - rnf f5 `seq` rnf f6 `seq` rnf f7 `seq` rnf f8 `seq` - rnf f9 `seq` rnf f10 `seq` rnf f11 `seq` rnf f12 `seq` rnf f13 + rnf (ModIfaceBackend{ mi_iface_hash, mi_mod_hash, mi_flag_hash, mi_opt_hash + , mi_hpc_hash, mi_plugin_hash, mi_orphan, mi_finsts, mi_exp_hash + , mi_orphan_hash, mi_warn_fn, mi_fix_fn, mi_hash_fn}) + = rnf mi_iface_hash + `seq` rnf mi_mod_hash + `seq` rnf mi_flag_hash + `seq` rnf mi_opt_hash + `seq` rnf mi_hpc_hash + `seq` rnf mi_plugin_hash + `seq` rnf mi_orphan + `seq` rnf mi_finsts + `seq` rnf mi_exp_hash + `seq` rnf mi_orphan_hash + `seq` rnf mi_warn_fn + `seq` rnf mi_fix_fn + `seq` rnf mi_hash_fn forceModIface :: ModIface -> IO () ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -33,6 +33,9 @@ -fbang-patterns -fbuilding-cabal-package -fconstraint-solver-iterations +-fgivens-expansion-fuel +-fwanteds-expansion-fuel +-fqcs-expansion-fuel -fcontext-stack -fcross-module-specialize -fdiagnostics-color=always ===================================== libraries/base/tests/all.T ===================================== @@ -79,7 +79,9 @@ test('length001', # excessive amounts of stack space. So we specifically set a low # stack limit and mark it as failing under a few conditions. [extra_run_opts('+RTS -K8m -RTS'), - expect_fail_for(['normal', 'threaded1', 'llvm', 'nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc'])], + expect_fail_for(['normal', 'threaded1', 'llvm', 'nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc']), + # JS doesn't support stack limit so the test sometimes passes just fine. We decrease the timeout duration to force the failure. + when(js_arch(), run_timeout_multiplier(0.2))], compile_and_run, ['']) test('ratio001', normal, compile_and_run, ['']) ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -31,6 +31,7 @@ module Language.Haskell.TH.Syntax -- $infix ) where +import qualified Data.Fixed as Fixed import Data.Data hiding (Fixity(..)) import Data.IORef import System.IO.Unsafe ( unsafePerformIO ) @@ -1056,6 +1057,15 @@ instance Lift Natural where liftTyped x = unsafeCodeCoerce (lift x) lift x = return (LitE (IntegerL (fromIntegral x))) +instance Lift (Fixed.Fixed a) where + liftTyped x = unsafeCodeCoerce (lift x) + lift (Fixed.MkFixed x) = do + ex <- lift x + return (ConE mkFixedName `AppE` ex) + where + mkFixedName = + mkNameG DataName "base" "Data.Fixed" "MkFixed" + instance Integral a => Lift (Ratio a) where liftTyped x = unsafeCodeCoerce (lift x) lift x = return (LitE (RationalL (toRational x))) ===================================== libraries/template-haskell/changelog.md ===================================== @@ -7,6 +7,7 @@ * Add `TypeDataD` constructor to the `Dec` type for `type data` declarations (GHC proposal #106). + * Add `instance Lift (Fixed a)` ## 2.19.0.0 ===================================== testsuite/driver/testlib.py ===================================== @@ -129,14 +129,17 @@ def no_deps( name, opts): def skip( name, opts ): opts.skip = True +def js_arch() -> bool: + return arch("javascript"); + # disable test on JS arch def js_skip( name, opts ): - if arch("javascript"): + if js_arch(): skip(name,opts) # expect broken for the JS backend def js_broken( bug: IssueNumber ): - if arch("javascript"): + if js_arch(): return expect_broken(bug); else: return normal; ===================================== testsuite/tests/simplCore/should_compile/T22761.hs ===================================== @@ -0,0 +1,40 @@ +module T22761 where + +import T22761a + +newtype Mod m = Mod m deriving Num + +gcdExt :: Integer -> (Integer, Integer) +gcdExt x = go 0 x + where + go !_ 0 = (1, 1) + go r _ = go r r + +pow :: (Num m) => Mod m -> Mod m +pow x = x*x*x +{-# NOINLINE [1] pow #-} +{-# RULES +"powMod/3/Int" forall x. pow x = x*x*x +#-} + + +-- GHC puts `boo1` after `wom1` (since they don't appear connected) +-- Then { wom1 = foo True } rewrites to { wom1 = boo False } +-- so we need to do glomming. And that triggers the bug +-- in the RULE for `pow`! +-- +-- wom2/boo2 are there to still elicit the bug if +-- GHC reverses its default ordering + +{-# RULES +"wombat1" foo True = boo1 False +#-} + +wom1 = foo True +boo1 x = x + +{-# RULES +"wombat2" foo True = boo2 False +#-} +boo2 x = x +wom2 = foo True ===================================== testsuite/tests/simplCore/should_compile/T22761a.hs ===================================== @@ -0,0 +1,4 @@ +module T22761a where + +{-# NOINLINE [0] foo #-} +foo x = x ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -471,5 +471,6 @@ test('T22611', [when(wordsize(32), skip), grep_errmsg(r'\$salterF') ], compile, test('T22715_2', normal, multimod_compile, ['T22715_2', '-v0 -O -fspecialise-aggressively']) test('T22802', normal, compile, ['-O']) test('T15205', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) +test('T22761', normal, multimod_compile, ['T22761', '-O2 -v0']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) ===================================== testsuite/tests/typecheck/should_compile/T21909.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +module T21909 where + +import Data.Kind + +class (Monad m, MyMonad (Inner m)) => MyMonad m where + type Inner m :: Type -> Type + foo :: m Int + +works :: MyMonad m => m String +works = show <$> ((+ 1) <$> foo) + +fails :: MyMonad m => m String +fails = show <$> fooPlusOne + where + fooPlusOne = (+ 1) <$> foo + +alsoFails :: MyMonad m => m String +alsoFails = + let fooPlusOne = (+ 1) <$> foo + in show <$> fooPlusOne ===================================== testsuite/tests/typecheck/should_compile/T21909b.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableSuperClasses, FunctionalDependencies, MultiParamTypeClasses, GADTs #-} + +module T21909b where + +class C [a] => C a where + foo :: a -> Int + +bar :: C a => a -> Int +bar x = foolocal x + where + foolocal a = foo a ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -857,3 +857,5 @@ test('T22647', normal, compile, ['']) test('T19577', normal, compile, ['']) test('T22383', normal, compile, ['']) test('T21501', normal, compile, ['']) +test('T21909', normal, compile, ['']) +test('T21909b', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a1e7ebe91fcc68e5d9857535d8b352a1b95725ae...b8c266eb17100cd908c65f3a39213ec1c5e06f24 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a1e7ebe91fcc68e5d9857535d8b352a1b95725ae...b8c266eb17100cd908c65f3a39213ec1c5e06f24 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 10 15:27:17 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 10 Feb 2023 10:27:17 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/mp-ghci-fixes-9.6 Message-ID: <63e66255c7b7e_1cf8af526e856748@gitlab.mail> Matthew Pickering pushed new branch wip/mp-ghci-fixes-9.6 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/mp-ghci-fixes-9.6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 10 15:29:23 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 10 Feb 2023 10:29:23 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/ghci-run-segfault Message-ID: <63e662d3ab90_1cf8af52cb05696b@gitlab.mail> Matthew Pickering pushed new branch wip/ghci-run-segfault at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ghci-run-segfault You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 10 16:23:28 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 10 Feb 2023 11:23:28 -0500 Subject: [Git][ghc/ghc][wip/mp-backports-batch-2] 2 commits: testsuite: Mark T15633 as fixed when static linking Message-ID: <63e66f809f437_1cf8af5265c748c9@gitlab.mail> Ben Gamari pushed to branch wip/mp-backports-batch-2 at Glasgow Haskell Compiler / GHC Commits: f0da1dda by Ben Gamari at 2023-02-10T11:20:56-05:00 testsuite: Mark T15633 as fixed when static linking Fixes #20706 - - - - - bcc6c918 by Ben Gamari at 2023-02-10T11:23:08-05:00 relnotes: Mention release notes - - - - - 2 changed files: - docs/users_guide/9.6.1-notes.rst - testsuite/tests/ghci/should_run/all.T Changes: ===================================== docs/users_guide/9.6.1-notes.rst ===================================== @@ -3,6 +3,14 @@ Version 9.6.1 ============== +The significant changes to the various parts of the compiler are listed in the +following sections. See the `migration guide +`_ on the GHC Wiki +for specific guidance on migrating programs to this release. + +The :ghc-flag:`LLVM backend <-fllvm>` of this release is to be used with LLVM +10, 11, 12, 13, or 14. + Language ~~~~~~~~ ===================================== testsuite/tests/ghci/should_run/all.T ===================================== @@ -47,7 +47,6 @@ test('T15369', just_ghci, ghci_script, ['T15369.script']) test('T15633a', [extra_files(['tc-plugin-ghci/']), when(opsys('mingw32'), [multi_cpu_race, fragile(16813)]), - when(opsys('linux') and not ghc_dynamic(), expect_broken(20706)), only_ways(['ghci']), pre_cmd('$MAKE -s --no-print-directory -C tc-plugin-ghci package.plugins01 TOP={top}'), extra_hc_opts("-package-db tc-plugin-ghci/pkg.plugins01/local.package.conf -fplugin TcPluginGHCi") View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f63da175da1f4196d9beab6571998fdd444835d4...bcc6c918baf9164922813e4f05bd41854e274002 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f63da175da1f4196d9beab6571998fdd444835d4...bcc6c918baf9164922813e4f05bd41854e274002 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 10 16:36:08 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Fri, 10 Feb 2023 11:36:08 -0500 Subject: [Git][ghc/ghc][wip/T22948] Don't generate datacon wrappers for `type data` declarations Message-ID: <63e67278e0102_1cf8af5268481146@gitlab.mail> Ryan Scott pushed to branch wip/T22948 at Glasgow Haskell Compiler / GHC Commits: 2a2d7aa4 by Ryan Scott at 2023-02-10T11:36:00-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch: * Modifies the criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper to factor in whether or not its parent data type was declared with `type data`. * Deletes some redundant wrapper-checking criteria in `GHC.Iface.Tidy.getTyConImplicitBinds`, as these are subsumed by `mkDataConRep`. After this patch, all of the criteria are listed in `mkDataConRep`. Fixes #22948. - - - - - 5 changed files: - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Types/Id/Make.hs - + testsuite/tests/type-data/should_run/T22948.hs - testsuite/tests/type-data/should_run/all.T Changes: ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -614,9 +614,8 @@ getImplicitBinds tc = cls_binds ++ getTyConImplicitBinds tc cls_binds = maybe [] getClassImplicitBinds (tyConClass_maybe tc) getTyConImplicitBinds :: TyCon -> [CoreBind] -getTyConImplicitBinds tc - | isNewTyCon tc = [] -- See Note [Compulsory newtype unfolding] in GHC.Types.Id.Make - | otherwise = map get_defn (mapMaybe dataConWrapId_maybe (tyConDataCons tc)) +getTyConImplicitBinds tc = + map get_defn (mapMaybe dataConWrapId_maybe (tyConDataCons tc)) getClassImplicitBinds :: Class -> [CoreBind] getClassImplicitBinds cls ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -2132,6 +2132,20 @@ The main parts of the implementation are: `type data` declarations. When these are converted back to Hs types in a splice, the constructors are placed in the TcCls namespace. +* A `type data` declaration _never_ generates wrappers for its data + constructors, as they only make sense for value-level data constructors. + This extends to `type data` declarations implemented as GADTs, such as + this example from #22948: + + type data T a where + A :: T Int + B :: T a + + If `T` were an ordinary `data` declaration, then `A` would have a wrapper + to account for the GADT-like equality in its return type. Because `T` is + declared as a `type data` declaration, however, the wrapper is omitted. + See `wrapped_reqd` in GHC.Types.Id.Make.mkDataConRep` for the place where + this check is implemented. -} warnNoDerivStrat :: Maybe (LDerivStrategy GhcRn) ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -789,24 +789,45 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con (unboxers, boxers) = unzip wrappers (rep_tys, rep_strs) = unzip (concat rep_tys_w_strs) + -- This is True if the data constructor or class dictionary constructor + -- needs a wrapper. This wrapper is injected into the program later in the + -- CoreTidy pass. See Note [Injecting implicit bindings] in GHC.Iface.Tidy, + -- along with the accompanying implementation in getTyConImplicitBinds. wrapper_reqd = (not new_tycon - -- (Most) newtypes have only a worker, with the exception + -- (Most) newtypes have only a worker (see + -- Note [Compulsory newtype unfolding]), with the exception -- of some newtypes written with GADT syntax. See below. - && (any isBanged (ev_ibangs ++ arg_ibangs))) + && (any isBanged (ev_ibangs ++ arg_ibangs) -- Some forcing/unboxing (includes eq_spec) - || isFamInstTyCon tycon -- Cast result - || dataConUserTyVarsNeedWrapper data_con + || isFamInstTyCon tycon + -- Cast the result + || not (null stupid_theta))) + -- If the data constructor has a datatype context, + -- we need a wrapper in order to drop the stupid arguments. + -- See Note [Instantiating stupid theta] in GHC.Core.DataCon. + || (dataConUserTyVarsNeedWrapper data_con -- If the data type was written with GADT syntax and -- orders the type variables differently from what the -- worker expects, it needs a data con wrapper to reorder -- the type variables. -- See Note [Data con wrappers and GADT syntax]. - -- NB: All GADTs return true from this function - || not (null stupid_theta) - -- If the data constructor has a datatype context, - -- we need a wrapper in order to drop the stupid arguments. - -- See Note [Instantiating stupid theta] in GHC.Core.DataCon. + -- + -- NB: All GADTs return true from this function, but there + -- is one exception that we must check below. + && not (isTypeDataTyCon tycon)) + -- An exception to this rule is `type data` declarations. + -- Their data constructors only live at the type level and + -- therefore do not need wrappers. + -- See Note [Type data declarations] in GHC.Rename.Module. + -- + -- Note that the earlier checks in this definition will + -- return False for `type data` declarations, as: + -- + -- - They cannot be newtypes + -- - They have strict fields + -- - They cannot be data family instances + -- - They cannot have datatype contexts initial_wrap_app = Var (dataConWorkId data_con) `mkTyApps` res_ty_args ===================================== testsuite/tests/type-data/should_run/T22948.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeData #-} +module Main where + +type data T a where + A :: T Int + B :: T a + +main = return () ===================================== testsuite/tests/type-data/should_run/all.T ===================================== @@ -1,3 +1,4 @@ test('T22332a', exit_code(1), compile_and_run, ['']) test('T22315b', extra_files(['T22315b.hs']), ghci_script, ['T22315b.script']) test('T22500', normal, compile_and_run, ['']) +test('T22948', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2a2d7aa43f7ceb26b42684fefceec0c91183b294 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2a2d7aa43f7ceb26b42684fefceec0c91183b294 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 10 17:54:56 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Fri, 10 Feb 2023 12:54:56 -0500 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] Adjust sizes for 32bit in stack_misc_closures test Message-ID: <63e684f05dc91_1cf8af52698101268@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: ffa31521 by Sven Tennie at 2023-02-10T17:54:06+00:00 Adjust sizes for 32bit in stack_misc_closures test - - - - - 1 changed file: - libraries/ghc-heap/tests/stack_misc_closures.hs Changes: ===================================== libraries/ghc-heap/tests/stack_misc_closures.hs ===================================== @@ -13,6 +13,8 @@ module Main where -- TODO: Remove later + +import Data.Functor import Debug.Trace import GHC.Exts import GHC.Exts.DecodeStack @@ -24,7 +26,6 @@ import GHC.Stack.CloneStack (StackSnapshot (..)) import System.Mem import TestUtils import Unsafe.Coerce (unsafeCoerce) -import Data.Functor foreign import prim "any_update_framezh" any_update_frame# :: SetupFunction @@ -176,9 +177,9 @@ main = do assertEqual (tipe info) RET_SMALL assertEqual knownRetSmallType None pCs <- mapM getBoxedClosureData payload - assertEqual (length pCs) (fromIntegral maxSmallBitmapBits_c) + assertEqual (length pCs) maxSmallBitmapBits let wds = map getWordFromConstr01 pCs - assertEqual wds [1 .. 58] + assertEqual wds [1 .. maxSmallBitmapBits] e -> error $ "Wrong closure type: " ++ show e traceM $ "Test 16" testSize any_ret_small_closures_frame# (1 + fromIntegral maxSmallBitmapBits_c) @@ -189,9 +190,9 @@ main = do assertEqual (tipe info) RET_SMALL assertEqual knownRetSmallType None pCs <- mapM getBoxedClosureData payload - assertEqual (length pCs) (fromIntegral maxSmallBitmapBits_c) + assertEqual (length pCs) maxSmallBitmapBits let wds = map getWordFromUnknownTypeWordSizedPrimitive pCs - assertEqual wds [1 .. 58] + assertEqual wds [1 .. maxSmallBitmapBits] e -> error $ "Wrong closure type: " ++ show e traceM $ "Test 18" testSize any_ret_small_prims_frame# (1 + fromIntegral maxSmallBitmapBits_c) @@ -201,9 +202,9 @@ main = do RetBig {..} -> do assertEqual (tipe info) RET_BIG pCs <- mapM getBoxedClosureData payload - assertEqual (length pCs) 59 + assertEqual (length pCs) minBigBitmapBits let wds = map getWordFromUnknownTypeWordSizedPrimitive pCs - assertEqual wds [1 .. 59] + assertEqual wds [1 .. minBigBitmapBits] e -> error $ "Wrong closure type: " ++ show e traceM $ "Test 20" testSize any_ret_big_prims_min_frame# (minBigBitmapBits + 1) @@ -213,9 +214,9 @@ main = do RetBig {..} -> do assertEqual (tipe info) RET_BIG pCs <- mapM getBoxedClosureData payload - assertEqual (length pCs) 59 + assertEqual (length pCs) minBigBitmapBits let wds = map getWordFromConstr01 pCs - assertEqual wds [1 .. 59] + assertEqual wds [1 .. minBigBitmapBits] e -> error $ "Wrong closure type: " ++ show e traceM $ "Test 22" testSize any_ret_big_closures_min_frame# (minBigBitmapBits + 1) @@ -267,6 +268,7 @@ main = do traceM $ "Test 27" testSize any_ret_fun_arg_gen_framezh# (3 + 9) traceM $ "Test 28" + -- TODO: Check names: # and zh test any_ret_fun_arg_gen_big_framezh# $ \case RetFun {..} -> do @@ -386,7 +388,7 @@ test setup assertion = do entertainGC :: Int -> String entertainGC 0 = "0" -entertainGC x = show x ++ entertainGC (x -1) +entertainGC x = show x ++ entertainGC (x - 1) testSize :: HasCallStack => SetupFunction -> Int -> IO () testSize setup expectedSize = do @@ -461,7 +463,10 @@ unboxSingletonTuple :: (# StackSnapshot# #) -> StackSnapshot# unboxSingletonTuple (# s# #) = s# minBigBitmapBits :: Num a => a -minBigBitmapBits = 1 + fromIntegral maxSmallBitmapBits_c +minBigBitmapBits = 1 + maxSmallBitmapBits + +maxSmallBitmapBits :: Num a => a +maxSmallBitmapBits = fromIntegral maxSmallBitmapBits_c -- | A function with 59 arguments -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ffa315219d7d537e32863d35f3f41acbbfb44692 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ffa315219d7d537e32863d35f3f41acbbfb44692 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Feb 10 18:25:27 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Fri, 10 Feb 2023 13:25:27 -0500 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] Simplify show instances Message-ID: <63e68c17a3136_1cf8af52bc01047fc@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: 4584b6c5 by Sven Tennie at 2023-02-10T18:19:42+00:00 Simplify show instances - - - - - 3 changed files: - libraries/base/GHC/Stack/CloneStack.hs - libraries/base/cbits/StackCloningDecoding.cmm - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs Changes: ===================================== libraries/base/GHC/Stack/CloneStack.hs ===================================== @@ -20,14 +20,14 @@ module GHC.Stack.CloneStack ( cloneMyStack, cloneThreadStack, decode, - stackSnapshotToWord + stackSnapshotToString ) where import Control.Concurrent.MVar import Data.Maybe (catMaybes) import Foreign import GHC.Conc.Sync -import GHC.Exts (Int (I#), RealWorld, StackSnapshot#, ThreadId#, Array#, sizeofArray#, indexArray#, State#, StablePtr#, Word#) +import GHC.Exts (Int (I#), RealWorld, StackSnapshot#, ThreadId#, Array#, sizeofArray#, indexArray#, State#, StablePtr#, Word#, unsafeCoerce#) import GHC.IO (IO (..)) import GHC.InfoProv (InfoProv (..), InfoProvEnt, ipLoc, ipeProv, peekInfoProv) import GHC.Stable @@ -41,14 +41,14 @@ data StackSnapshot = StackSnapshot !StackSnapshot# instance Show StackSnapshot where showsPrec _ stack rs = - "StackSnapshot(" ++ pad_out (showHex addr "") ++ ")" ++ rs + "StackSnapshot(" ++ stackSnapshotToString stack ++ ")" ++ rs + +stackSnapshotToString :: StackSnapshot -> String +stackSnapshotToString (StackSnapshot s#) = pad_out (showHex addr "") where - addr = stackSnapshotToWord stack + addr = W# (unsafeCoerce# s#) pad_out ls = '0':'x':ls -stackSnapshotToWord :: StackSnapshot -> Word -stackSnapshotToWord (StackSnapshot s#) = W# (stackSnapshotToWord# s#) - instance Eq StackSnapshot where (StackSnapshot s1#) == (StackSnapshot s2#) = (W# (eqStacks# s1# s2#)) > 0 @@ -58,8 +58,6 @@ foreign import prim "stg_cloneMyStackzh" cloneMyStack# :: State# RealWorld -> (# foreign import prim "stg_sendCloneStackMessagezh" sendCloneStackMessage# :: ThreadId# -> StablePtr# PrimMVar -> State# RealWorld -> (# State# RealWorld, (# #) #) -foreign import prim "stackSnapshotToWordzh" stackSnapshotToWord# :: StackSnapshot# -> Word# - foreign import prim "eqStackszh" eqStacks# :: StackSnapshot# -> StackSnapshot# -> Word# {- ===================================== libraries/base/cbits/StackCloningDecoding.cmm ===================================== @@ -25,11 +25,6 @@ stg_decodeStackzh (gcptr stgStack) { return (stackEntries); } -// Just a cast -stackSnapshotToWordzh(P_ stack) { - return (stack); -} - eqStackszh(P_ stack1, P_ stack2) { return (stack1 == stack2); } ===================================== libraries/ghc-heap/GHC/Exts/Heap/Closures.hs ===================================== @@ -54,7 +54,7 @@ import GHC.Generics import Numeric #if MIN_TOOL_VERSION_ghc(9,5,0) -import GHC.Stack.CloneStack (StackSnapshot(..), stackSnapshotToWord) +import GHC.Stack.CloneStack (StackSnapshot(..), stackSnapshotToString) import GHC.Exts.StackConstants #endif @@ -84,7 +84,8 @@ data StackFrameIter = } instance Eq StackFrameIter where - (SfiStackClosure s1#) == (SfiStackClosure s2#) = (StackSnapshot s1#) == (StackSnapshot s2#) + (SfiStackClosure s1#) == (SfiStackClosure s2#) = + (StackSnapshot s1#) == (StackSnapshot s2#) (SfiClosure s1# i1) == (SfiClosure s2# i2) = (StackSnapshot s1#) == (StackSnapshot s2#) && i1 == i2 @@ -93,23 +94,13 @@ instance Eq StackFrameIter where && i1 == i2 _ == _ = False --- TODO: Reduce duplication in where clause instance Show StackFrameIter where showsPrec _ (SfiStackClosure s#) rs = - "SfiStackClosure { stackSnapshot# = " ++ pad_out (showHex addr "") ++ "}" ++ rs - where - addr = stackSnapshotToWord (StackSnapshot s#) - pad_out ls = '0':'x':ls + "SfiStackClosure { stackSnapshot# = " ++ stackSnapshotToString (StackSnapshot s#) ++ "}" ++ rs showsPrec _ (SfiClosure s# i ) rs = - "SfiClosure { stackSnapshot# = " ++ pad_out (showHex addr "") ++ ", index = " ++ show i ++ ", " ++ "}" ++ rs - where - addr = stackSnapshotToWord (StackSnapshot s#) - pad_out ls = '0':'x':ls + "SfiClosure { stackSnapshot# = " ++ stackSnapshotToString (StackSnapshot s#) ++ show i ++ ", " ++ "}" ++ rs showsPrec _ (SfiPrimitive s# i ) rs = - "SfiPrimitive { stackSnapshot# = " ++ pad_out (showHex addr "") ++ ", index = " ++ show i ++ ", " ++ "}" ++ rs - where - addr = stackSnapshotToWord (StackSnapshot s#) - pad_out ls = '0':'x':ls + "SfiPrimitive { stackSnapshot# = " ++ stackSnapshotToString (StackSnapshot s#) ++ show i ++ ", " ++ "}" ++ rs -- | An arbitrary Haskell value in a safe Box. -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4584b6c505ded3cbd6e0544f5f91f0114fc1e1ec -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4584b6c505ded3cbd6e0544f5f91f0114fc1e1ec You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Feb 11 01:49:08 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 10 Feb 2023 20:49:08 -0500 Subject: [Git][ghc/ghc][wip/T22404] 18 commits: Update `Data.List.singleton` doc comment Message-ID: <63e6f4149563_50c52526c09143c@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 9959c95b by Simon Peyton Jones at 2023-02-10T18:39:18+00:00 Work in progress on #22404 Very much not ready! - - - - - 688c529d by Sebastian Graf at 2023-02-10T18:39:18+00:00 Partition into OneOccs and ManyOccs - - - - - 12dad6ab by Simon Peyton Jones at 2023-02-10T18:39:18+00:00 Wibbles - - - - - 636d0580 by Simon Peyton Jones at 2023-02-10T18:39:18+00:00 Refactor WithTailJoinDetails - - - - - a7733cbf by Simon Peyton Jones at 2023-02-10T18:39:18+00:00 Wibbles - - - - - 5e2f4779 by Simon Peyton Jones at 2023-02-10T18:39:18+00:00 Wibbles - - - - - 1693f381 by Simon Peyton Jones at 2023-02-10T18:39:18+00:00 Major wibbles - - - - - 092ae329 by Simon Peyton Jones at 2023-02-10T18:39:18+00:00 Wibble - - - - - fc501737 by Simon Peyton Jones at 2023-02-10T18:39:18+00:00 Vital fix to alt_env - - - - - 5da33394 by Simon Peyton Jones at 2023-02-10T18:39:18+00:00 Comments - - - - - 66c44df2 by Simon Peyton Jones at 2023-02-11T02:38:58+01:00 Another crucial change Fixing a wrongly-zapped occ_join_points ..and a DEBUG check to catch it if it happens again - - - - - 23 changed files: - .gitlab/merge_request_templates/merge-request.md - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Types/Unique/FM.hs - compiler/GHC/Unit/Module/ModIface.hs - libraries/base/Data/OldList.hs - libraries/base/tests/all.T - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - libraries/template-haskell/changelog.md - testsuite/driver/testlib.py - + testsuite/tests/simplCore/should_compile/T22761.hs - + testsuite/tests/simplCore/should_compile/T22761a.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== .gitlab/merge_request_templates/merge-request.md ===================================== @@ -5,18 +5,19 @@ expectations. Also please answer the following question in your MR description:* **Where is the key part of this patch? That is, what should reviewers look at first?** -Please take a few moments to verify that your commits fulfill the following: +Please take a few moments to address the following points: - * [ ] are either individually buildable or squashed - * [ ] have commit messages which describe *what they do* - (referring to [Notes][notes] and tickets using `#NNNN` syntax when - appropriate) + * [ ] if your MR may break existing programs (e.g. touches `base` or causes the + compiler to reject programs), please describe the expected breakage and add + the ~"user facing" label. This will run ghc/head.hackage> to characterise + the effect of your change on Hackage. + * [ ] ensure that your commits are either individually buildable or squashed + * [ ] ensure that your commit messages describe *what they do* + (referring to tickets using `#NNNN` syntax when appropriate) * [ ] have added source comments describing your change. For larger changes you likely should add a [Note][notes] and cross-reference it from the relevant places. - * [ ] add a [testcase to the testsuite](https://gitlab.haskell.org/ghc/ghc/wikis/building/running-tests/adding). - * [ ] if your MR affects library interfaces (e.g. changes `base`) or affects whether GHC will accept user-written code, please add - the ~"user facing" label. + * [ ] add a [testcase to the testsuite][adding test]. * [ ] updates the users guide if applicable * [ ] mentions new features in the release notes for the next release @@ -29,3 +30,4 @@ no one has offerred review in a few days then please leave a comment mentioning @triagers. [notes]: https://gitlab.haskell.org/ghc/ghc/wikis/commentary/coding-style#comments-in-the-source-code +[adding test]: https://gitlab.haskell.org/ghc/ghc/wikis/building/running-tests/adding ===================================== compiler/GHC/Core.hs ===================================== @@ -1300,16 +1300,19 @@ data Unfolding df_args :: [CoreExpr] -- Args of the data con: types, superclasses and methods, } -- in positional order - | CoreUnfolding { -- An unfolding for an Id with no pragma, - -- or perhaps a NOINLINE pragma - -- (For NOINLINE, the phase, if any, is in the - -- InlinePragInfo for this Id.) - uf_tmpl :: CoreExpr, -- Template; occurrence info is correct - uf_src :: UnfoldingSource, -- Where the unfolding came from - uf_is_top :: Bool, -- True <=> top level binding - uf_cache :: UnfoldingCache, -- Cache of flags computable from the expr - -- See Note [Tying the 'CoreUnfolding' knot] - uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template. + | CoreUnfolding { -- An unfolding for an Id with no pragma, + -- or perhaps a NOINLINE pragma + -- (For NOINLINE, the phase, if any, is in the + -- InlinePragInfo for this Id.) + uf_tmpl :: CoreExpr, -- The unfolding itself (aka "template") + -- Always occ-analysed; + -- See Note [OccInfo in unfoldings and rules] + + uf_src :: UnfoldingSource, -- Where the unfolding came from + uf_is_top :: Bool, -- True <=> top level binding + uf_cache :: UnfoldingCache, -- Cache of flags computable from the expr + -- See Note [Tying the 'CoreUnfolding' knot] + uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template. } -- ^ An unfolding with redundant cached information. Parameters: -- @@ -1637,14 +1640,37 @@ change was requested by Roman, but it seems to make sense. Note [OccInfo in unfoldings and rules] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In unfoldings and rules, we guarantee that the template is occ-analysed, -so that the occurrence info on the binders is correct. This is important, -because the Simplifier does not re-analyse the template when using it. If -the occurrence info is wrong - - We may get more simplifier iterations than necessary, because - once-occ info isn't there - - More seriously, we may get an infinite loop if there's a Rec - without a loop breaker marked +In unfoldings and rules, we guarantee that the template is occ-analysed, so +that the occurrence info on the binders is correct. That way, when the +Simplifier inlines an unfolding, it doesn't need to occ-analysis it first. +(The Simplifier is designed to simplify occ-analysed expressions.) + +Given this decision it's vital that we do *always* do it. + +* If we don't, we may get more simplifier iterations than necessary, + because once-occ info isn't there + +* More seriously, we may get an infinite loop if there's a Rec without a + loop breaker marked. + +* Or we may get code that mentions variables not in scope: #22761 + e.g. Suppose we have a stable unfolding : \y. let z = p+1 in 3 + Then the pre-simplifier occ-anal will occ-anal the unfolding + (redundantly perhaps, but we need its free vars); this will not report + the use of `p`; so p's binding will be discarded, and yet `p` is still + mentioned. + + Better to occ-anal the unfolding at birth, which will drop the + z-binding as dead code. (Remember, it's the occurrence analyser that + drops dead code.) + +* Another example is #8892: + \x -> letrec { f = ...g...; g* = f } in body + where g* is (for some strange reason) the loop breaker. If we don't + occ-anal it when reading it in, we won't mark g as a loop breaker, and we + may inline g entirely in body, dropping its binding, and leaving the + occurrence in f out of scope. This happened in #8892, where the unfolding + in question was a DFun unfolding. ************************************************************************ ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -3088,8 +3088,15 @@ etaExpandToJoinPointRule join_arity rule@(Rule { ru_bndrs = bndrs, ru_rhs = rhs | need_args < 0 = pprPanic "etaExpandToJoinPointRule" (ppr join_arity $$ ppr rule) | otherwise - = rule { ru_bndrs = bndrs ++ new_bndrs, ru_args = args ++ new_args - , ru_rhs = new_rhs } + = rule { ru_bndrs = bndrs ++ new_bndrs + , ru_args = args ++ new_args + , ru_rhs = new_rhs } + -- new_rhs really ought to be occ-analysed (see GHC.Core Note + -- [OccInfo in unfoldings and rules]), but it makes a module loop to + -- do so; it doesn't happen often; and it doesn't really matter if + -- the outer binders have bogus occurrence info; and new_rhs won't + -- have dead code if rhs didn't. + where need_args = join_arity - length args (new_bndrs, new_rhs) = etaBodyForJoinPoint need_args rhs ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -1935,10 +1935,13 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs -- The normal case | otherwise -- NB: threshold_arity might be less than -- manifest arity for join points - = -- pprTrace "finaliseArgBoxities" ( + = -- pprTrace "finaliseArgBoxities {" ( -- vcat [text "function:" <+> ppr fn + -- , text "max" <+> ppr max_wkr_args -- , text "dmds before:" <+> ppr (map idDemandInfo (filter isId bndrs)) - -- , text "dmds after: " <+> ppr arg_dmds' ]) $ + -- , text "triples:" <+> ppr arg_triples ]) $ + -- pprTrace "finalase 2 }" ( + -- vcat [ text "dmds after: " <+> ppr arg_dmds' ]) $ (arg_dmds', add_demands arg_dmds' rhs) -- add_demands: we must attach the final boxities to the lambda-binders -- of the function, both because that's kosher, and because CPR analysis ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -1,7 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ViewPatterns #-} -{-# OPTIONS_GHC -Wno-incomplete-record-updates #-} +{-# OPTIONS_GHC -cpp -Wno-incomplete-record-updates #-} {- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 @@ -58,7 +58,7 @@ import GHC.Utils.Misc import GHC.Builtin.Names( runRWKey ) import GHC.Unit.Module( Module ) -import Data.List (mapAccumL, mapAccumR) +import Data.List (mapAccumL) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE @@ -76,7 +76,7 @@ Here's the externally-callable interface: occurAnalyseExpr :: CoreExpr -> CoreExpr occurAnalyseExpr expr = expr' where - (WithUsageDetails _ expr') = occAnal initOccEnv expr + WUD _ expr' = occAnal initOccEnv expr occurAnalysePgm :: Module -- Used only in debug output -> (Id -> Bool) -- Active unfoldings @@ -94,8 +94,8 @@ occurAnalysePgm this_mod active_unf active_rule imp_rules binds init_env = initOccEnv { occ_rule_act = active_rule , occ_unf_act = active_unf } - (WithUsageDetails final_usage occ_anald_binds) = go init_env binds - (WithUsageDetails _ occ_anald_glommed_binds) = occAnalRecBind init_env TopLevel + WUD final_usage occ_anald_binds = go binds init_env + WUD _ occ_anald_glommed_binds = occAnalRecBind init_env TopLevel imp_rule_edges (flattenBinds binds) initial_uds @@ -127,14 +127,10 @@ occurAnalysePgm this_mod active_unf active_rule imp_rules binds -- Not BuiltinRules; see Note [Plugin rules] , let rhs_fvs = exprFreeIds rhs `delVarSetList` bndrs ] - go :: OccEnv -> [CoreBind] -> WithUsageDetails [CoreBind] - go !_ [] - = WithUsageDetails initial_uds [] - go env (bind:binds) - = WithUsageDetails final_usage (bind' ++ binds') - where - (WithUsageDetails bs_usage binds') = go env binds - (WithUsageDetails final_usage bind') = occAnalBind env TopLevel imp_rule_edges bind bs_usage + go :: [CoreBind] -> OccEnv -> WithUsageDetails [CoreBind] + go [] _ = WUD initial_uds [] + go (bind:binds) env = occAnalBind env TopLevel + imp_rule_edges bind (go binds) (++) {- ********************************************************************* * * @@ -599,7 +595,124 @@ This showed up when compiling Control.Concurrent.Chan.getChanContents. Hence the transitive rule_fv_env stuff described in Note [Rules and loop breakers]. ------------------------------------------------------------- +Note [Occurrence analysis for join points] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider these two somewhat artificial programs (#22404) + + Program (P1) Program (P2) + ------------------------------ ------------------------------------- + let v = in let v = in + join j = case v of (a,b) -> a + in case x of in case x of + A -> case v of (a,b) -> a A -> j + B -> case v of (a,b) -> a B -> j + C -> case v of (a,b) -> b C -> case v of (a,b) -> b + D -> [] D -> [] + +In (P1), `v` gets allocated, as a thunk, every time this code is executed. But +notice that `v` occurs at most once in any case branch; the occurrence analyser +spots this and returns a OneOcc{ occ_n_br = 3 } for `v`. Then the code in +GHC.Core.Opt.Simplify.Utils.postInlineUnconditionally inlines `v` at its three +use sites, and discards the let-binding. That way, we avoid allocating `v` in +the A,B,C branches (though we still compute it of course), and branch D +doesn't involve at all. This sometimes makes a Really Big +Difference. + +In (P2) we have shared the common RHS of A, B, in a join point `j`. We would +like to inline `v1 in just the same way as in (P1). But if we "andUDs" +the usage from j's RHS and its body, we'll get ManyOccs for `v`. Important +optimisation lost! + +The occurrence analyser therefore has clever code that behaves just as +if you inlined `j` at all its call sites. Here is a tricky variant (P3) +to keep in mind: + join j = case v of (a,b) -> a + in case f v of + A -> j + B -> j + C -> [] +If you mentally inline `j` you'll see that `v` is used twice on the path +through A, so it should have ManyOcc. Bear this caes in mind! + +* We treat /non-recursive/ join points specially. Recursive join points + are treated like any other letrec, as before. Moreover, we only + deal with /pre-existing/ non-recursive join points, not the ones + that we discover for the first time in this sweep of the + occurrence analyser. + +* In occ_env, the new (occ_join_points :: IdEnv UsageDetails) maps + each in-scope non-recursive join point, such as `j` above, to + a "zeroed form" of its RHS's usage details. The "zeroed form" + * deletes ManyOccs + * maps a OneOcc to OneOcc{ occ_n_br = 0 } + In our example, occ_join_points will be extended with + [j :-> [v :-> OneOcc{occ_n_br=0}]] + See addJoinPoint. + +* At an occurence of a join point, we do everything as normal, but add in the + UsageDetails from the occ_join_points. See mkOneOcc. + +* At the NonRec binding of the join point, we use `orUDs`, not `andUDs` to + combine the usage from the RHS with the usage from the body. + +Here are the consequences + +* Because of the perhaps-surprising OneOcc{occ_n_br=0} idea of the zeroed + form, the occ_n_br field of a OneOcc binder still counts the number of + /actual lexical occurrences/ of the variable. In Program P2, for example, + `v` will end up with OneOcc{occ_n_br=2}, not occ_n_br=3. There are two + lexical occurrences of `v`! + +* In the tricky (P3) we'll get an `andUDs` of + * OneOcc{occ_n_br=0} from the occurrences of `j`) + * OneOcc{occ_n_br=1} from the (f v) + These are `andUDs` together, and hence `addOccInfo`, and hence + `v` gets ManyOccs, just as it should. Clever! + +There are a couple of tricky wrinkles + +(W1) Consider this example which shadows `j`: + join j = rhs in + in case x of { K j -> ..j..; ... } + Clearly when we come to the pattern `K j` we must drop the `j` + entry in occ_join_points. + + This is done by `drop_shadowed_joins` in `addInScope`. + +(W2) Consider this example which shadows `v`: + join j = ...v... + in case x of { K v -> ..j..; ... } + + We can't make j's occurrences in the K alternative give rise to an + occurrence of `v` (via occ_join_points), because it'll just be deleted by + the `K v` pattern. Yikes. This is rare because shadowing is rare, but + it definitely can happen. Solution: when bringing `v` into scope at + the `K v` pattern, chuck out of occ_join_points any elements whose + UsageDetails mentions `v`. Instead, just `andUDs` all that usage in + right here. + + This is done by `add_bad_joins`` in `addInScope`; we use + `partitionVarEnv` to identify the `bad_joins` (the ones whose + UsageDetails mention the newly bound variables); then for any of /those/ + that are /actually mentioned/ in the body, use `andUDs` to add their + UsageDetails to the returned UsageDetails. Tricky! + +(W3) Consider this example, which shadows `j`, but this time in an argument + join j = rhs + in f (case x of { K j -> ...; ... }) + We can zap the entire occ_join_points when looking at the argument, + because `j` can't posibly occur -- it's a join point! And the smaller + occ_join_points is, the better. Smaller to look up in mkOneOcc, and + more important, less looking-up when partitioning in (W2), in addInScope. + + This is done in setNonTailCtxt. It's important /not/ to do this for + join-point RHS's because of course `j` can occur there! + + NB: this is just about efficiency: it is always safe /not/ to zap the + occ_join_points. + +Wrinkles (W1) and (W2) are very similar to Note [Binder swap] (BS3). + Note [Finding join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~ It's the occurrence analyser's job to find bindings that we can turn into join @@ -817,41 +930,76 @@ of both functions, serving as a specification: Non-recursive case: 'adjustNonRecRhs' -} -data WithUsageDetails a = WithUsageDetails !UsageDetails !a - -data WithTailUsageDetails a = WithTailUsageDetails !TailUsageDetails !a - ------------------------------------------------------------------ -- occAnalBind ------------------------------------------------------------------ -occAnalBind :: OccEnv -- The incoming OccEnv - -> TopLevelFlag - -> ImpRuleEdges - -> CoreBind - -> UsageDetails -- Usage details of scope - -> WithUsageDetails [CoreBind] -- Of the whole let(rec) +occAnalBind + :: OccEnv + -> TopLevelFlag + -> ImpRuleEdges + -> CoreBind + -> (OccEnv -> WithUsageDetails r) -- Scope of the bind + -> ([CoreBind] -> r -> r) -- How to combine the scope with new binds + -> WithUsageDetails r -- Of the whole let(rec) + +occAnalBind env lvl ire (Rec pairs) thing_inside combine + = addInScope env (map fst pairs) $ \env -> + let WUD body_uds body' = thing_inside env + WUD bind_uds binds' = occAnalRecBind env lvl ire pairs body_uds + in WUD bind_uds (combine binds' body') + +occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine + | isTyVar bndr -- A type let; we don't gather usage info + = let !(WUD body_uds res) = addInScope env [bndr] thing_inside + in WUD body_uds (combine [NonRec bndr rhs] res) + + -- Non-recursive join points + | NotTopLevel <- lvl + , mb_join@(Just {}) <- isJoinId_maybe bndr + , not (isStableUnfolding (realIdUnfolding bndr)) + , not (idHasRules bndr) + = let -- Analyse the rhs first, generating rhs_uds + WUD rhs_uds rhs' = adjustNonRecRhs mb_join $ + occAnalLamTail (setTailCtxt env) rhs + + -- Now analyse the body, adding the join point + -- into the environment with addJoinPoint + WUD body_uds (tagged_bndr, body) + = occAnalNonRecBody env lvl bndr $ \env -> + thing_inside (addJoinPoint env bndr rhs_uds) + in + if isDeadBinder tagged_bndr -- Drop dead code; see Note [Dead code] + then WUD body_uds body + else WUD (rhs_uds `orUDs` body_uds) + (combine [NonRec tagged_bndr rhs'] body) -occAnalBind !env lvl top_env (NonRec binder rhs) body_usage - = occAnalNonRecBind env lvl top_env binder rhs body_usage -occAnalBind env lvl top_env (Rec pairs) body_usage - = occAnalRecBind env lvl top_env pairs body_usage + -- The normal case + | otherwise + = let WUD body_uds (tagged_bndr, body) = occAnalNonRecBody env lvl bndr thing_inside + WUD bind_uds binds = occAnalNonRecRhs env ire tagged_bndr rhs + in + if isDeadBinder tagged_bndr -- Drop dead code; see Note [Dead code] + then WUD body_uds body + else WUD (bind_uds `andUDs` body_uds) + (combine binds body) ----------------- -occAnalNonRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> Var -> CoreExpr - -> UsageDetails -> WithUsageDetails [CoreBind] -occAnalNonRecBind !env lvl imp_rule_edges bndr rhs body_usage - | isTyVar bndr -- A type let; we don't gather usage info - = WithUsageDetails body_usage [NonRec bndr rhs] - - | not (bndr `usedIn` body_usage) - = WithUsageDetails body_usage [] -- See Note [Dead code] +occAnalNonRecBody :: OccEnv -> TopLevelFlag -> Id + -> (OccEnv -> WithUsageDetails r) -- Scope of the bind + -> (WithUsageDetails (Id, r)) +occAnalNonRecBody env lvl bndr thing_inside + = addInScope env [bndr] $ \env -> + let !(WUD inner_uds res) = thing_inside env + tagged_bndr = tagNonRecBinder lvl inner_uds bndr + in WUD inner_uds (tagged_bndr, res) - | otherwise -- It's mentioned in the body - = WithUsageDetails (body_usage' `andUDs` rhs_usage) [NonRec final_bndr final_rhs] +----------------- +occAnalNonRecRhs :: OccEnv -> ImpRuleEdges -> Id -> CoreExpr + -> WithUsageDetails [CoreBind] +occAnalNonRecRhs !env imp_rule_edges tagged_bndr rhs + = WUD rhs_usage [NonRec final_bndr final_rhs] where - WithUsageDetails body_usage' tagged_bndr = tagNonRecBinder lvl body_usage bndr - -- Get the join info from the *new* decision -- See Note [Join points and unfoldings/rules] -- => join arity O of Note [Join arity prediction based on joinRhsArity] @@ -859,9 +1007,10 @@ occAnalNonRecBind !env lvl imp_rule_edges bndr rhs body_usage is_join_point = isJust mb_join_arity --------- Right hand side --------- - env1 | is_join_point = env -- See Note [Join point RHSs] - | certainly_inline = env -- See Note [Cascading inlines] - | otherwise = rhsCtxt env + env1 | is_join_point = setTailCtxt env + | otherwise = setNonTailCtxt rhs_ctxt env + rhs_ctxt | certainly_inline = OccVanilla -- See Note [Cascading inlines] + | otherwise = OccRhs -- See Note [Sources of one-shot information] rhs_env = env1 { occ_one_shots = argOneShots dmd } @@ -869,26 +1018,25 @@ occAnalNonRecBind !env lvl imp_rule_edges bndr rhs body_usage -- Match join arity O from mb_join_arity with manifest join arity M as -- returned by of occAnalLamTail. It's totally OK for them to mismatch; -- hence adjust the UDs from the RHS - WithUsageDetails adj_rhs_uds final_rhs - = adjustNonRecRhs mb_join_arity $ occAnalLamTail rhs_env rhs + WUD adj_rhs_uds final_rhs = adjustNonRecRhs mb_join_arity $ + occAnalLamTail rhs_env rhs rhs_usage = adj_rhs_uds `andUDs` adj_unf_uds `andUDs` adj_rule_uds final_bndr = tagged_bndr `setIdSpecialisation` mkRuleInfo rules' `setIdUnfolding` unf2 --------- Unfolding --------- -- See Note [Join points and unfoldings/rules] - unf | isId bndr = idUnfolding bndr - | otherwise = NoUnfolding - WithTailUsageDetails unf_uds unf1 = occAnalUnfolding rhs_env unf + unf = idUnfolding tagged_bndr + WTUD unf_tuds unf1 = occAnalUnfolding rhs_env unf unf2 = markNonRecUnfoldingOneShots mb_join_arity unf1 - adj_unf_uds = adjustTailArity mb_join_arity unf_uds + adj_unf_uds = adjustTailArity mb_join_arity unf_tuds --------- Rules --------- -- See Note [Rules are extra RHSs] and Note [Rule dependency info] -- and Note [Join points and unfoldings/rules] - rules_w_uds = occAnalRules rhs_env bndr + rules_w_uds = occAnalRules rhs_env tagged_bndr rules' = map fstOf3 rules_w_uds - imp_rule_uds = impRulesScopeUsage (lookupImpRules imp_rule_edges bndr) + imp_rule_uds = impRulesScopeUsage (lookupImpRules imp_rule_edges tagged_bndr) -- imp_rule_uds: consider -- h = ... -- g = ... @@ -909,9 +1057,9 @@ occAnalNonRecBind !env lvl imp_rule_edges bndr rhs body_usage -> active && not_stable _ -> False - dmd = idDemandInfo bndr - active = isAlwaysActive (idInlineActivation bndr) - not_stable = not (isStableUnfolding (idUnfolding bndr)) + dmd = idDemandInfo tagged_bndr + active = isAlwaysActive (idInlineActivation tagged_bndr) + not_stable = not (isStableUnfolding unf) ----------------- occAnalRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> [(Var,CoreExpr)] @@ -921,8 +1069,8 @@ occAnalRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> [(Var,CoreExpr)] -- * compute strongly-connected components -- * feed those components to occAnalRec -- See Note [Recursive bindings: the grand plan] -occAnalRecBind !env lvl imp_rule_edges pairs body_usage - = foldr (occAnalRec rhs_env lvl) (WithUsageDetails body_usage []) sccs +occAnalRecBind !rhs_env lvl imp_rule_edges pairs body_usage + = foldr (occAnalRec rhs_env lvl) (WUD body_usage []) sccs where sccs :: [SCC NodeDetails] sccs = {-# SCC "occAnalBind.scc" #-} @@ -934,21 +1082,6 @@ occAnalRecBind !env lvl imp_rule_edges pairs body_usage bndrs = map fst pairs bndr_set = mkVarSet bndrs - rhs_env = env `addInScope` bndrs - -adjustNonRecRhs :: Maybe JoinArity -> WithTailUsageDetails CoreExpr -> WithUsageDetails CoreExpr --- ^ This function concentrates shared logic between occAnalNonRecBind and the --- AcyclicSCC case of occAnalRec. --- * It applies 'markNonRecJoinOneShots' to the RHS --- * and returns the adjusted rhs UsageDetails combined with the body usage -adjustNonRecRhs mb_join_arity (WithTailUsageDetails rhs_tuds rhs) - = WithUsageDetails rhs_uds' rhs' - where - --------- Marking (non-rec) join binders one-shot --------- - !rhs' | Just ja <- mb_join_arity = markNonRecJoinOneShots ja rhs - | otherwise = rhs - --------- Adjusting right-hand side usage --------- - rhs_uds' = adjustTailUsage mb_join_arity rhs' rhs_tuds bindersOfSCC :: SCC NodeDetails -> [Var] bindersOfSCC (AcyclicSCC nd) = [nd_bndr nd] @@ -962,28 +1095,29 @@ occAnalRec :: OccEnv -> TopLevelFlag -- Check for Note [Dead code] -- NB: Only look at body_uds, ignoring uses in the SCC -occAnalRec !_ _ scc (WithUsageDetails body_uds binds) +occAnalRec !_ _ scc (WUD body_uds binds) | not (any (`usedIn` body_uds) (bindersOfSCC scc)) - = WithUsageDetails body_uds binds + = WUD body_uds binds -- The NonRec case is just like a Let (NonRec ...) above occAnalRec !_ lvl (AcyclicSCC (ND { nd_bndr = bndr, nd_rhs = wtuds })) - (WithUsageDetails body_uds binds) - = WithUsageDetails (body_uds' `andUDs` rhs_uds') (NonRec bndr' rhs' : binds) + (WUD body_uds binds) + = WUD (body_uds `andUDs` rhs_uds') + (NonRec bndr' rhs' : binds) where - WithUsageDetails body_uds' tagged_bndr = tagNonRecBinder lvl body_uds bndr + tagged_bndr = tagNonRecBinder lvl body_uds bndr mb_join_arity = willBeJoinId_maybe tagged_bndr - WithUsageDetails rhs_uds' rhs' = adjustNonRecRhs mb_join_arity wtuds + WUD rhs_uds' rhs' = adjustNonRecRhs mb_join_arity wtuds !unf' = markNonRecUnfoldingOneShots mb_join_arity (idUnfolding tagged_bndr) !bndr' = tagged_bndr `setIdUnfolding` unf' -- The Rec case is the interesting one -- See Note [Recursive bindings: the grand plan] -- See Note [Loop breaking] -occAnalRec env lvl (CyclicSCC details_s) (WithUsageDetails body_uds binds) +occAnalRec env lvl (CyclicSCC details_s) (WUD body_uds binds) = -- pprTrace "occAnalRec" (ppr loop_breaker_nodes) - WithUsageDetails final_uds (Rec pairs : binds) + WUD final_uds (Rec pairs : binds) where all_simple = all nd_simple details_s @@ -992,7 +1126,7 @@ occAnalRec env lvl (CyclicSCC details_s) (WithUsageDetails body_uds binds) -- See Note [Choosing loop breakers] for loop_breaker_nodes final_uds :: UsageDetails loop_breaker_nodes :: [LoopBreakerNode] - (WithUsageDetails final_uds loop_breaker_nodes) = mkLoopBreakerNodes env lvl body_uds details_s + (WUD final_uds loop_breaker_nodes) = mkLoopBreakerNodes env lvl body_uds details_s ------------------------------ weak_fvs :: VarSet @@ -1481,7 +1615,8 @@ instance Outputable NodeDetails where , text "simple =" <+> ppr (nd_simple nd) , text "active_rule_fvs =" <+> ppr (nd_active_rule_fvs nd) ]) - where WithTailUsageDetails uds _ = nd_rhs nd + where + WTUD uds _ = nd_rhs nd -- | Digraph with simplified and completely occurrence analysed -- 'SimpleNodeDetails', retaining just the info we need for breaking loops. @@ -1525,7 +1660,7 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs) -- explained in Note [Deterministic SCC] in GHC.Data.Graph.Directed. where details = ND { nd_bndr = bndr' - , nd_rhs = WithTailUsageDetails scope_uds rhs' + , nd_rhs = WTUD (TUD rhs_ja unadj_scope_uds) rhs' , nd_inl = inl_fvs , nd_simple = null rules_w_uds && null imp_rule_info , nd_weak_fvs = weak_fvs @@ -1538,7 +1673,6 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs) -- JoinArity rhs_ja of unadj_rhs_uds. unadj_inl_uds = unadj_rhs_uds `andUDs` adj_unf_uds unadj_scope_uds = unadj_inl_uds `andUDs` adj_rule_uds - scope_uds = TUD rhs_ja unadj_scope_uds -- Note [Rules are extra RHSs] -- Note [Rule dependency info] scope_fvs = udFreeVars bndr_set unadj_scope_uds @@ -1566,15 +1700,16 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs) -- Instead, do the occAnalLamTail call here and postpone adjustTailUsage -- until occAnalRec. In effect, we pretend that the RHS becomes a -- non-recursive join point and fix up later with adjustTailUsage. - rhs_env = rhsCtxt env - WithTailUsageDetails (TUD rhs_ja unadj_rhs_uds) rhs' = occAnalLamTail rhs_env rhs + rhs_env | isJoinId bndr = setTailCtxt env + | otherwise = setNonTailCtxt OccRhs env + WTUD (TUD rhs_ja unadj_rhs_uds) rhs' = occAnalLamTail rhs_env rhs -- corresponding call to adjustTailUsage in occAnalRec and tagRecBinders --------- Unfolding --------- -- See Note [Join points and unfoldings/rules] unf = realIdUnfolding bndr -- realIdUnfolding: Ignore loop-breaker-ness -- here because that is what we are setting! - WithTailUsageDetails unf_tuds unf' = occAnalUnfolding rhs_env unf + WTUD unf_tuds unf' = occAnalUnfolding rhs_env unf adj_unf_uds = adjustTailArity (Just rhs_ja) unf_tuds -- `rhs_ja` is `joinRhsArity rhs` and is the prediction for source M -- of Note [Join arity prediction based on joinRhsArity] @@ -1590,8 +1725,8 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs) -- `rhs_ja` is `joinRhsArity rhs'` and is the prediction for source M -- of Note [Join arity prediction based on joinRhsArity] rules_w_uds :: [(CoreRule, UsageDetails, UsageDetails)] - rules_w_uds = [ (r,l,adjustTailArity (Just rhs_ja) rhs_tuds) - | (r,l,rhs_tuds) <- occAnalRules rhs_env bndr ] + rules_w_uds = [ (r,l,adjustTailArity (Just rhs_ja) rhs_wuds) + | (r,l,rhs_wuds) <- occAnalRules rhs_env bndr ] rules' = map fstOf3 rules_w_uds adj_rule_uds = foldr add_rule_uds imp_rule_uds rules_w_uds @@ -1624,11 +1759,12 @@ mkLoopBreakerNodes :: OccEnv -> TopLevelFlag -- d) adjust each RHS's usage details according to -- the binder's (new) shotness and join-point-hood mkLoopBreakerNodes !env lvl body_uds details_s - = WithUsageDetails final_uds (zipWithEqual "mkLoopBreakerNodes" mk_lb_node details_s bndrs') + = WUD final_uds (zipWithEqual "mkLoopBreakerNodes" mk_lb_node details_s bndrs') where - WithUsageDetails final_uds bndrs' = tagRecBinders lvl body_uds details_s + WUD final_uds bndrs' = tagRecBinders lvl body_uds details_s - mk_lb_node nd@(ND { nd_bndr = old_bndr, nd_inl = inl_fvs }) new_bndr + mk_lb_node nd@(ND { nd_bndr = old_bndr, nd_inl = inl_fvs + , nd_rhs = WTUD _ rhs }) new_bndr = DigraphNode { node_payload = simple_nd , node_key = varUnique old_bndr , node_dependencies = nonDetKeysUniqSet lb_deps } @@ -1637,7 +1773,6 @@ mkLoopBreakerNodes !env lvl body_uds details_s -- in nondeterministic order as explained in -- Note [Deterministic SCC] in GHC.Data.Graph.Directed. where - WithTailUsageDetails _ rhs = nd_rhs nd simple_nd = SND { snd_bndr = new_bndr, snd_rhs = rhs, snd_score = score } score = nodeScore env new_bndr lb_deps nd lb_deps = extendFvs_ rule_fv_env inl_fvs @@ -1677,7 +1812,7 @@ nodeScore :: OccEnv -> NodeDetails -> NodeScore nodeScore !env new_bndr lb_deps - (ND { nd_bndr = old_bndr, nd_rhs = WithTailUsageDetails _ bind_rhs }) + (ND { nd_bndr = old_bndr, nd_rhs = WTUD _ bind_rhs }) | not (isId old_bndr) -- A type or coercion variable is never a loop breaker = (100, 0, False) @@ -1974,18 +2109,25 @@ occAnalLamTail :: OccEnv -> CoreExpr -> WithTailUsageDetails CoreExpr -- In effect, the analysis result is for a non-recursive join point with -- manifest arity and adjustTailUsage does the fixup. -- See Note [Adjusting right-hand sides] -occAnalLamTail env (Lam bndr expr) +occAnalLamTail env expr + = let WUD usage expr' = occ_anal_lam_tail env expr + in WTUD (TUD (joinRhsArity expr) usage) expr' + +occ_anal_lam_tail :: OccEnv -> CoreExpr -> WithUsageDetails CoreExpr +-- Does not markInsidLam etc for the outmost batch of lambdas +occ_anal_lam_tail env (Lam bndr expr) | isTyVar bndr - , let env1 = addOneInScope env bndr - , WithTailUsageDetails (TUD ja usage) expr' <- occAnalLamTail env1 expr - = WithTailUsageDetails (TUD (ja+1) usage) (Lam bndr expr') - -- Important: Keep the 'env' unchanged so that with a RHS like + = addInScope env [bndr] $ \env -> + let WUD usage expr' = occ_anal_lam_tail env expr + in WUD usage (Lam bndr expr') + -- Important: Do not modify occ_encl, so that with a RHS like -- \(@ x) -> K @x (f @x) -- we'll see that (K @x (f @x)) is in a OccRhs, and hence refrain -- from inlining f. See the beginning of Note [Cascading inlines]. | otherwise -- So 'bndr' is an Id - = let (env_one_shots', bndr1) + = addInScope env [bndr] $ \env -> + let (env_one_shots', bndr1) = case occ_one_shots env of [] -> ([], bndr) (os : oss) -> (oss, updOneShotInfo bndr os) @@ -1995,15 +2137,14 @@ occAnalLamTail env (Lam bndr expr) -- See Note [The oneShot function] env1 = env { occ_encl = OccVanilla, occ_one_shots = env_one_shots' } - env2 = addOneInScope env1 bndr - WithTailUsageDetails (TUD ja usage) expr' = occAnalLamTail env2 expr - (usage', bndr2) = tagLamBinder usage bndr1 - in WithTailUsageDetails (TUD (ja+1) usage') (Lam bndr2 expr') + WUD usage expr' = occ_anal_lam_tail env1 expr + bndr2 = tagLamBinder usage bndr1 + in WUD usage (Lam bndr2 expr') -- For casts, keep going in the same lambda-group -- See Note [Occurrence analysis for lambda binders] -occAnalLamTail env (Cast expr co) - = let WithTailUsageDetails (TUD ja usage) expr' = occAnalLamTail env expr +occ_anal_lam_tail env (Cast expr co) + = let WUD usage expr' = occ_anal_lam_tail env expr -- usage1: see Note [Gather occurrences of coercion variables] usage1 = addManyOccs usage (coVarsOfCo co) @@ -2019,10 +2160,10 @@ occAnalLamTail env (Cast expr co) -- GHC.Core.Lint: Note Note [Join points and casts] usage3 = markAllNonTail usage2 - in WithTailUsageDetails (TUD ja usage3) (Cast expr' co) + in WUD usage3 (Cast expr' co) -occAnalLamTail env expr = case occAnal env expr of - WithUsageDetails usage expr' -> WithTailUsageDetails (TUD 0 usage) expr' +occ_anal_lam_tail env expr -- Not Lam, not Cast + = occAnal env expr {- Note [Occ-anal and cast worker/wrapper] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2063,13 +2204,14 @@ occAnalUnfolding !env unf unf@(CoreUnfolding { uf_tmpl = rhs, uf_src = src }) | isStableSource src -> let - WithTailUsageDetails (TUD rhs_ja usage) rhs' = occAnalLamTail env rhs + WTUD (TUD rhs_ja uds) rhs' = occAnalLamTail env rhs unf' | noBinderSwaps env = unf -- Note [Unfoldings and rules] | otherwise = unf { uf_tmpl = rhs' } - in WithTailUsageDetails (TUD rhs_ja (markAllMany usage)) unf' + in WTUD (TUD rhs_ja (markAllMany uds)) unf' -- markAllMany: see Note [Occurrences in stable unfoldings] - | otherwise -> WithTailUsageDetails (TUD 0 emptyDetails) unf + + | otherwise -> WTUD (TUD 0 emptyDetails) unf -- For non-Stable unfoldings we leave them undisturbed, but -- don't count their usage because the simplifier will discard them. -- We leave them undisturbed because nodeScore uses their size info @@ -2078,15 +2220,13 @@ occAnalUnfolding !env unf -- scope remain in scope; there is no cloning etc. unf@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) - -> WithTailUsageDetails (TUD 0 final_usage) (unf { df_args = args' }) - where - env' = env `addInScope` bndrs - (WithUsageDetails usage args') = occAnalList env' args - final_usage = usage `addLamCoVarOccs` bndrs `delDetailsList` bndrs - -- delDetailsList; no need to use tagLamBinders because we + -> let WUD uds args' = addInScope env bndrs $ \ env -> + occAnalList env args + in WTUD (TUD 0 uds) (unf { df_args = args' }) + -- No need to use tagLamBinders because we -- never inline DFuns so the occ-info on binders doesn't matter - unf -> WithTailUsageDetails (TUD 0 emptyDetails) unf + unf -> WTUD (TUD 0 emptyDetails) unf occAnalRules :: OccEnv -> Id -- Get rules from here @@ -2099,22 +2239,22 @@ occAnalRules !env bndr occ_anal_rule rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs }) = (rule', lhs_uds', TUD rhs_ja rhs_uds') where - env' = env `addInScope` bndrs rule' | noBinderSwaps env = rule -- Note [Unfoldings and rules] | otherwise = rule { ru_args = args', ru_rhs = rhs' } - (WithUsageDetails lhs_uds args') = occAnalList env' args - lhs_uds' = markAllManyNonTail (lhs_uds `delDetailsList` bndrs) - `addLamCoVarOccs` bndrs + WUD lhs_uds args' = addInScope env bndrs $ \env -> + occAnalList env args - (WithUsageDetails rhs_uds rhs') = occAnal env' rhs + lhs_uds' = markAllManyNonTail lhs_uds + WUD rhs_uds rhs' = addInScope env bndrs $ \env -> + occAnal env rhs -- Note [Rules are extra RHSs] -- Note [Rule dependency info] - rhs_uds' = markAllMany $ - rhs_uds `delDetailsList` bndrs + rhs_uds' = markAllMany rhs_uds rhs_ja = length args -- See Note [Join points and unfoldings/rules] - occ_anal_rule other_rule = (other_rule, emptyDetails, TUD 0 emptyDetails) + occ_anal_rule other_rule = ( other_rule, emptyDetails + , TUD 0 emptyDetails ) {- Note [Join point RHSs] ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2165,9 +2305,20 @@ So we have a fast-path that keeps the old tree if the occ_bs_env is empty. This just saves a bit of allocation and reconstruction; not a big deal. +This fast path exposes a tricky cornder, though (#22761). Supose we have + Unfolding = \x. let y = foo in x+1 +which includes a dead binding for `y`. In occAnalUnfolding we occ-anal +the unfolding and produce /no/ occurrences of `foo` (since `y` is +dead). But if we discard the occ-analysed syntax tree (which we do on +our fast path), and use the old one, we still /have/ an occurrence of +`foo` -- and that can lead to out-of-scope variables (#22761). + +Solution: always keep occ-analysed trees in unfoldings and rules, so they +have no dead code. See Note [OccInfo in unfoldings and rules] in GHC.Core. + Note [Cascading inlines] ~~~~~~~~~~~~~~~~~~~~~~~~ -By default we use an rhsCtxt for the RHS of a binding. This tells the +By default we use an OccRhs for the RHS of a binding. This tells the occ anal n that it's looking at an RHS, which has an effect in occAnalApp. In particular, for constructor applications, it makes the arguments appear to have NoOccInfo, so that we don't inline into @@ -2188,7 +2339,7 @@ Result: multiple simplifier iterations. Sigh. So, when analysing the RHS of x3 we notice that x3 will itself definitely inline the next time round, and so we analyse x3's rhs in -an ordinary context, not rhsCtxt. Hence the "certainly_inline" stuff. +an OccVanilla context, not OccRhs. Hence the "certainly_inline" stuff. Annoyingly, we have to approximate GHC.Core.Opt.Simplify.Utils.preInlineUnconditionally. If (a) the RHS is expandable (see isExpandableApp in occAnalApp), and @@ -2218,17 +2369,17 @@ for the various clauses. -} occAnalList :: OccEnv -> [CoreExpr] -> WithUsageDetails [CoreExpr] -occAnalList !_ [] = WithUsageDetails emptyDetails [] +occAnalList !_ [] = WUD emptyDetails [] occAnalList env (e:es) = let - (WithUsageDetails uds1 e') = occAnal env e - (WithUsageDetails uds2 es') = occAnalList env es - in WithUsageDetails (uds1 `andUDs` uds2) (e' : es') + (WUD uds1 e') = occAnal env e + (WUD uds2 es') = occAnalList env es + in WUD (uds1 `andUDs` uds2) (e' : es') occAnal :: OccEnv -> CoreExpr -> WithUsageDetails CoreExpr -- Gives info only about the "interesting" Ids -occAnal !_ expr@(Lit _) = WithUsageDetails emptyDetails expr +occAnal !_ expr@(Lit _) = WUD emptyDetails expr occAnal env expr@(Var _) = occAnalApp env (expr, [], []) -- At one stage, I gathered the idRuleVars for the variable here too, @@ -2239,9 +2390,9 @@ occAnal env expr@(Var _) = occAnalApp env (expr, [], []) -- weren't used at all. occAnal _ expr@(Type ty) - = WithUsageDetails (addManyOccs emptyDetails (coVarsOfType ty)) expr + = WUD (addManyOccs emptyDetails (coVarsOfType ty)) expr occAnal _ expr@(Coercion co) - = WithUsageDetails (addManyOccs emptyDetails (coVarsOfCo co)) expr + = WUD (addManyOccs emptyDetails (coVarsOfCo co)) expr -- See Note [Gather occurrences of coercion variables] {- Note [Gather occurrences of coercion variables] @@ -2290,22 +2441,22 @@ But it is not necessary to gather CoVars from the types of other binders. occAnal env (Tick tickish body) | SourceNote{} <- tickish - = WithUsageDetails usage (Tick tickish body') + = WUD usage (Tick tickish body') -- SourceNotes are best-effort; so we just proceed as usual. -- If we drop a tick due to the issues described below it's -- not the end of the world. | tickish `tickishScopesLike` SoftScope - = WithUsageDetails (markAllNonTail usage) (Tick tickish body') + = WUD (markAllNonTail usage) (Tick tickish body') | Breakpoint _ _ ids <- tickish - = WithUsageDetails (usage_lam `andUDs` foldr addManyOcc emptyDetails ids) (Tick tickish body') + = WUD (usage_lam `andUDs` foldr addManyOcc emptyDetails ids) (Tick tickish body') -- never substitute for any of the Ids in a Breakpoint | otherwise - = WithUsageDetails usage_lam (Tick tickish body') + = WUD usage_lam (Tick tickish body') where - (WithUsageDetails usage body') = occAnal env body + (WUD usage body') = occAnal env body -- for a non-soft tick scope, we can inline lambdas only usage_lam = markAllNonTail (markAllInsideLam usage) -- TODO There may be ways to make ticks and join points play @@ -2317,44 +2468,54 @@ occAnal env (Tick tickish body) -- See #14242. occAnal env (Cast expr co) - = let (WithUsageDetails usage expr') = occAnal env expr + = let (WUD usage expr') = occAnal env expr usage1 = addManyOccs usage (coVarsOfCo co) -- usage2: see Note [Gather occurrences of coercion variables] usage2 = markAllNonTail usage1 -- usage3: calls inside expr aren't tail calls any more - in WithUsageDetails usage2 (Cast expr' co) + in WUD usage2 (Cast expr' co) occAnal env app@(App _ _) = occAnalApp env (collectArgsTicks tickishFloatable app) occAnal env expr@(Lam {}) - = adjustNonRecRhs Nothing $ occAnalLamTail env expr -- mb_join_arity == Nothing <=> markAllManyNonTail + = adjustNonRecRhs Nothing $ -- Nothing <=> markAllManyNonTail + occAnalLamTail env expr occAnal env (Case scrut bndr ty alts) = let - (WithUsageDetails scrut_usage scrut') = occAnal (scrutCtxt env alts) scrut - alt_env = addBndrSwap scrut' bndr $ env { occ_encl = OccVanilla } `addOneInScope` bndr - (alts_usage_s, alts') = mapAndUnzip (do_alt alt_env) alts - alts_usage = foldr orUDs emptyDetails alts_usage_s - (alts_usage1, tagged_bndr) = tagLamBinder alts_usage bndr - total_usage = markAllNonTail scrut_usage `andUDs` alts_usage1 + WUD scrut_usage scrut' = occAnal (setScrutCtxt env alts) scrut + + WUD alts_usage (tagged_bndr, alts') + = addInScope env [bndr] $ \env -> + let alt_env = addBndrSwap scrut' bndr $ + setTailCtxt env -- Kill off OccRhs + WUD alts_usage alts' = do_alts alt_env alts + tagged_bndr = tagLamBinder alts_usage bndr + in WUD alts_usage (tagged_bndr, alts') + + total_usage = markAllNonTail scrut_usage `andUDs` alts_usage -- Alts can have tail calls, but the scrutinee can't - in WithUsageDetails total_usage (Case scrut' tagged_bndr ty alts') + + in WUD total_usage (Case scrut' tagged_bndr ty alts') where + do_alts :: OccEnv -> [CoreAlt] -> WithUsageDetails [CoreAlt] + do_alts _ [] = WUD emptyDetails [] + do_alts env (alt:alts) = WUD (uds1 `orUDs` uds2) (alt':alts') + where + WUD uds1 alt' = do_alt env alt + WUD uds2 alts' = do_alts env alts + do_alt !env (Alt con bndrs rhs) - = let - (WithUsageDetails rhs_usage1 rhs1) = occAnal (env `addInScope` bndrs) rhs - (alt_usg, tagged_bndrs) = tagLamBinders rhs_usage1 bndrs - in -- See Note [Binders in case alternatives] - (alt_usg, Alt con tagged_bndrs rhs1) + = addInScope env bndrs $ \ env -> + let WUD rhs_usage rhs' = occAnal env rhs + tagged_bndrs = tagLamBinders rhs_usage bndrs + in -- See Note [Binders in case alternatives] + WUD rhs_usage (Alt con tagged_bndrs rhs') occAnal env (Let bind body) - = let - body_env = env { occ_encl = OccVanilla } `addInScope` bindersOf bind - (WithUsageDetails body_usage body') = occAnal body_env body - (WithUsageDetails final_usage binds') = occAnalBind env NotTopLevel - noImpRuleEdges bind body_usage - in WithUsageDetails final_usage (mkLets binds' body') + = occAnalBind env NotTopLevel noImpRuleEdges bind + (\env -> occAnal env body) mkLets occAnalArgs :: OccEnv -> CoreExpr -> [CoreExpr] -> [OneShots] -> WithUsageDetails CoreExpr -- The `fun` argument is just an accumulating parameter, @@ -2362,14 +2523,16 @@ occAnalArgs :: OccEnv -> CoreExpr -> [CoreExpr] -> [OneShots] -> WithUsageDetail occAnalArgs !env fun args !one_shots = go emptyDetails fun args one_shots where - go uds fun [] _ = WithUsageDetails uds fun + env_args = setNonTailCtxt OccVanilla env + + go uds fun [] _ = WUD uds fun go uds fun (arg:args) one_shots = go (uds `andUDs` arg_uds) (fun `App` arg') args one_shots' where - !(WithUsageDetails arg_uds arg') = occAnal arg_env arg + !(WUD arg_uds arg') = occAnal arg_env arg !(arg_env, one_shots') | isTypeArg arg = (env, one_shots) - | otherwise = valArgCtxt env one_shots + | otherwise = addOneShots env_args one_shots {- Applications are dealt with specially because we want @@ -2403,19 +2566,19 @@ occAnalApp !env (Var fun, args, ticks) -- This caused #18296 | fun `hasKey` runRWKey , [t1, t2, arg] <- args - , WithUsageDetails usage arg' <- adjustNonRecRhs (Just 1) $ occAnalLamTail env arg - = WithUsageDetails usage (mkTicks ticks $ mkApps (Var fun) [t1, t2, arg']) + , WUD usage arg' <- adjustNonRecRhs (Just 1) $ occAnalLamTail env arg + = WUD usage (mkTicks ticks $ mkApps (Var fun) [t1, t2, arg']) occAnalApp env (Var fun_id, args, ticks) - = WithUsageDetails all_uds (mkTicks ticks app') + = WUD all_uds (mkTicks ticks app') where -- Lots of banged bindings: this is a very heavily bit of code, -- so it pays not to make lots of thunks here, all of which -- will ultimately be forced. !(fun', fun_id') = lookupBndrSwap env fun_id - !(WithUsageDetails args_uds app') = occAnalArgs env fun' args one_shots + !(WUD args_uds app') = occAnalArgs env fun' args one_shots - fun_uds = mkOneOcc fun_id' int_cxt n_args + fun_uds = mkOneOcc env fun_id' int_cxt n_args -- NB: fun_uds is computed for fun_id', not fun_id -- See (BS1) in Note [The binder-swap substitution] @@ -2451,13 +2614,13 @@ occAnalApp env (Var fun_id, args, ticks) -- See Note [Sources of one-shot information], bullet point A'] occAnalApp env (fun, args, ticks) - = WithUsageDetails (markAllNonTail (fun_uds `andUDs` args_uds)) + = WUD (markAllNonTail (fun_uds `andUDs` args_uds)) (mkTicks ticks app') where - !(WithUsageDetails args_uds app') = occAnalArgs env fun' args [] - !(WithUsageDetails fun_uds fun') = occAnal (addAppCtxt env args) fun + !(WUD args_uds app') = occAnalArgs env fun' args [] + !(WUD fun_uds fun') = occAnal (addAppCtxt env args) fun -- The addAppCtxt is a bit cunning. One iteration of the simplifier - -- often leaves behind beta redexs like + -- often leaves behind beta redexes like -- (\x y -> e) a1 a2 -- Here we would like to mark x,y as one-shot, and treat the whole -- thing much like a let. We do this by pushing some OneShotLam items @@ -2584,10 +2747,14 @@ data OccEnv -- then please replace x by (y |> mco) -- Invariant of course: idType x = exprType (y |> mco) , occ_bs_env :: !(IdEnv (OutId, MCoercion)) - -- Domain is Global and Local Ids - -- Range is just Local Ids + -- Domain is Global and Local Ids + -- Range is just Local Ids , occ_bs_rng :: !VarSet - -- Vars (TyVars and Ids) free in the range of occ_bs_env + -- Vars (TyVars and Ids) free in the range of occ_bs_env + + -- Usage details of the RHS of in-scope non-recursive join points + , occ_join_points :: !(IdEnv UsageDetails) + -- Invariant: no Id maps to emptyDetails } @@ -2630,17 +2797,20 @@ initOccEnv , occ_unf_act = \_ -> True , occ_rule_act = \_ -> True + , occ_join_points = emptyVarEnv , occ_bs_env = emptyVarEnv , occ_bs_rng = emptyVarSet } noBinderSwaps :: OccEnv -> Bool noBinderSwaps (OccEnv { occ_bs_env = bs_env }) = isEmptyVarEnv bs_env -scrutCtxt :: OccEnv -> [CoreAlt] -> OccEnv -scrutCtxt !env alts - | interesting_alts = env { occ_encl = OccScrut, occ_one_shots = [] } - | otherwise = env { occ_encl = OccVanilla, occ_one_shots = [] } +setScrutCtxt :: OccEnv -> [CoreAlt] -> OccEnv +setScrutCtxt !env alts + = setNonTailCtxt encl env where + encl | interesting_alts = OccScrut + | otherwise = OccVanilla + interesting_alts = case alts of [] -> False [alt] -> not (isDefaultAlt alt) @@ -2649,34 +2819,113 @@ scrutCtxt !env alts -- non-default alternative. That in turn influences -- pre/postInlineUnconditionally. Grep for "occ_int_cxt"! -rhsCtxt :: OccEnv -> OccEnv -rhsCtxt !env = env { occ_encl = OccRhs, occ_one_shots = [] } - -valArgCtxt :: OccEnv -> [OneShots] -> (OccEnv, [OneShots]) -valArgCtxt !env [] - = (env { occ_encl = OccVanilla, occ_one_shots = [] }, []) -valArgCtxt env (one_shots:one_shots_s) - = (env { occ_encl = OccVanilla, occ_one_shots = one_shots }, one_shots_s) +setNonTailCtxt :: OccEncl -> OccEnv -> OccEnv +setNonTailCtxt ctxt !env + = env { occ_encl = ctxt + , occ_one_shots = [] + , occ_join_points = zapped_jp_env } + where + -- zapped_jp_env is basically just emptyVarEnv (hence zapped). + -- See (W3) of Note [Occurrence analysis for join points] + -- Zapping improves efficiency, slightly, but it is /dangerous/. + -- If we zap [jx :-> uds], and then we find an occurrence of jx + -- anyway, we might lose those uds, and that might mean we don't + -- record all occurrencs, and that means we duplicate a redex.... + -- a very nasty bug (which I encountered!). Hence this DEBUG + -- code which doesn't remove jx from the envt; it just gives it + -- emptyDetails, which in turn causes a panic in mkOneOcc +#ifdef DEBUG + zapped_jp_env + = mapVarEnv (\ _ -> emptyDetails) $ + occ_join_points env +#else + zapped_jp_env = emptyVarEnv +#endif + +setTailCtxt :: OccEnv -> OccEnv +setTailCtxt !env + = env { occ_encl = OccVanilla } + -- Preserve occ_one_shots, occ_join points + -- Do not use OccRhs for the RHS of a join point (which is a tail ctxt): + -- see Note [Join point RHSs] + +addOneShots :: OccEnv -> [OneShots] -> (OccEnv, [OneShots]) +addOneShots !env one_shots + = case one_shots of + [] -> (env, []) + (os:oss) -> (env { occ_one_shots = os }, oss) isRhsEnv :: OccEnv -> Bool isRhsEnv (OccEnv { occ_encl = cxt }) = case cxt of OccRhs -> True _ -> False -addOneInScope :: OccEnv -> CoreBndr -> OccEnv --- Needed for all Vars not just Ids --- See Note [The binder-swap substitution] (BS3) -addOneInScope env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = rng_vars }) bndr - | bndr `elemVarSet` rng_vars = env { occ_bs_env = emptyVarEnv, occ_bs_rng = emptyVarSet } - | otherwise = env { occ_bs_env = swap_env `delVarEnv` bndr } +addInScope :: OccEnv -> [Var] -> (OccEnv -> WithUsageDetails a) + -> WithUsageDetails a +-- Needed for all Vars not just Ids; a TyVar might have a CoVars in its kind +addInScope env@(OccEnv { occ_join_points = join_points }) + bndrs thing_inside + = fix_up_uds $ thing_inside $ + drop_shadowed_swaps $ drop_shadowed_joins env + where + + drop_shadowed_swaps :: OccEnv -> OccEnv + -- See Note [The binder-swap substitution] (BS3) + drop_shadowed_swaps env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = bs_rng_vars }) + | any (`elemVarSet` bs_rng_vars) bndrs + = env { occ_bs_env = emptyVarEnv, occ_bs_rng = emptyVarSet } + | otherwise + = env { occ_bs_env = swap_env `delVarEnvList` bndrs } -addInScope :: OccEnv -> [Var] -> OccEnv --- Needed for all Vars not just Ids --- See Note [The binder-swap substitution] (BS3) -addInScope env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = rng_vars }) bndrs - | any (`elemVarSet` rng_vars) bndrs = env { occ_bs_env = emptyVarEnv, occ_bs_rng = emptyVarSet } - | otherwise = env { occ_bs_env = swap_env `delVarEnvList` bndrs } + drop_shadowed_joins :: OccEnv -> OccEnv + -- See Note [Occurrence analysis for join points] wrinkle (W1) + drop_shadowed_joins env = env { occ_join_points = good_joins `delVarEnvList` bndrs} + + fix_up_uds :: WithUsageDetails a -> WithUsageDetails a + -- Remove usage for bndrs + -- Add usage info for (a) CoVars used in the types of bndrs + -- and (b) occ_join_points that we cannot push inwards because of shadowing + fix_up_uds (WUD uds res) = WUD with_joins res + where + trimmed_uds = uds `delDetails` bndrs + with_co_var_occs = trimmed_uds `addManyOccs` coVarOccs bndrs + with_joins = add_bad_joins with_co_var_occs + add_bad_joins :: UsageDetails -> UsageDetails + add_bad_joins uds = nonDetStrictFoldUFM_Directly add_bad_join uds bad_joins + + add_bad_join :: Unique -> UsageDetails -- Bad join and its usage details + -> UsageDetails -> UsageDetails + -- See Note [Occurrence analysis for join points] wrinkle (W2) + add_bad_join uniq bad_join_uds uds + | uniq `elemUFM_Directly` ud_env uds = uds `andUDs` bad_join_uds + | otherwise = uds + + (bad_joins, good_joins) = partitionVarEnv bad_join_rhs join_points + + bad_join_rhs :: UsageDetails -> Bool + bad_join_rhs (UD { ud_env = rhs_usage }) = any (`elemVarEnv` rhs_usage) bndrs + +addJoinPoint :: OccEnv -> Id -> UsageDetails -> OccEnv +addJoinPoint env bndr rhs_uds + | isEmptyDetails zeroed_form + = env + | otherwise + = env { occ_join_points = extendVarEnv (occ_join_points env) bndr zeroed_form } + where + zeroed_form = mkZeroedForm rhs_uds + +mkZeroedForm :: UsageDetails -> UsageDetails +-- See Note [Occurrence analysis for join points] for "zeroed form" +mkZeroedForm rhs_uds@(UD { ud_env = rhs_occs }) + = emptyDetails { ud_env = mapMaybeUFM_Directly do_one rhs_occs } + where + do_one :: Unique -> OccInfo -> Maybe OccInfo + do_one key occ = case doZappingByUnique rhs_uds key occ of + ManyOccs {} -> Nothing + occ@(OneOcc {}) -> Just (occ { occ_n_br = 0 }) + IAmDead -> pprPanic "addJoinPoint" (ppr key) + IAmALoopBreaker {} -> pprPanic "addJoinPoint" (ppr key) -------------------- transClosureFV :: VarEnv VarSet -> VarEnv VarSet @@ -3097,9 +3346,10 @@ info then simply means setting the corresponding zapped set to the whole 'OccInfoEnv', a fast O(1) operation. -} -type OccInfoEnv = IdEnv OccInfo -- A finite map from ids to their usage - -- INVARIANT: never IAmDead - -- (Deadness is signalled by not being in the map at all) +type OccInfoEnv = IdEnv OccInfo -- A finite map from an expression's + -- free variables to their usage + -- INVARIANT: never IAmDead, or IAmLoopBreaker + -- Deadness is signalled by not being in the map at all type ZappedSet = OccInfoEnv -- Values are ignored @@ -3113,18 +3363,23 @@ data UsageDetails instance Outputable UsageDetails where ppr ud = ppr (ud_env (flattenUsageDetails ud)) --- | Captures the result of applying 'occAnalLamTail' to a function `\xyz.body`. --- The TailUsageDetails records + +--------------------- +-- | TailUsageDetails captures the result of applying 'occAnalLamTail' +-- to a function `\xyz.body`. The TailUsageDetails pairs together -- * the number of lambdas (including type lambdas: a JoinArity) --- * UsageDetails for the `body`, unadjusted by `adjustTailUsage`. --- If the binding turns out to be a join point with the indicated join --- arity, this unadjusted usage details is just what we need; otherwise we --- need to discard tail calls. That's what `adjustTailUsage` does. +-- * UsageDetails for the `body` of the lambda, unadjusted by `adjustTailUsage`. +-- If the binding turns out to be a join point with the indicated join +-- arity, this unadjusted usage details is just what we need; otherwise we +-- need to discard tail calls. That's what `adjustTailUsage` does. data TailUsageDetails = TUD !JoinArity !UsageDetails instance Outputable TailUsageDetails where ppr (TUD ja uds) = lambda <> ppr ja <> ppr uds +--------------------- +data WithUsageDetails a = WUD !UsageDetails !a +data WithTailUsageDetails a = WTUD !TailUsageDetails !a ------------------- -- UsageDetails API @@ -3134,17 +3389,25 @@ andUDs, orUDs andUDs = combineUsageDetailsWith addOccInfo orUDs = combineUsageDetailsWith orOccInfo -mkOneOcc :: Id -> InterestingCxt -> JoinArity -> UsageDetails -mkOneOcc id int_cxt arity - | isLocalId id - = emptyDetails { ud_env = unitVarEnv id occ_info } - | otherwise +mkOneOcc :: OccEnv -> Id -> InterestingCxt -> JoinArity -> UsageDetails +mkOneOcc !env id int_cxt arity + | not (isLocalId id) = emptyDetails + + | Just join_uds <- lookupVarEnv (occ_join_points env) id + = -- pprTrace "mkOneOcc" (ppr id $$ ppr uds) $ + assertPpr (not (isEmptyDetails join_uds)) (ppr id) $ + one_occ_uds `andUDs` join_uds + + | otherwise + = one_occ_uds + where - occ_info = OneOcc { occ_in_lam = NotInsideLam - , occ_n_br = oneBranch - , occ_int_cxt = int_cxt - , occ_tail = AlwaysTailCalled arity } + one_occ_uds = emptyDetails { ud_env = unitVarEnv id one_occ_info } + one_occ_info = OneOcc { occ_in_lam = NotInsideLam + , occ_n_br = oneBranch + , occ_int_cxt = int_cxt + , occ_tail = AlwaysTailCalled arity } addManyOccId :: UsageDetails -> Id -> UsageDetails -- Add the non-committal (id :-> noOccInfo) to the usage details @@ -3164,19 +3427,14 @@ addManyOccs :: UsageDetails -> VarSet -> UsageDetails addManyOccs usage id_set = nonDetStrictFoldUniqSet addManyOcc usage id_set -- It's OK to use nonDetStrictFoldUniqSet here because addManyOcc commutes -addLamCoVarOccs :: UsageDetails -> [Var] -> UsageDetails --- Add any CoVars free in the type of a lambda-binder +coVarOccs :: [Var] -> VarSet +-- Add any CoVars free in the types of a telescope of lambda-binders -- See Note [Gather occurrences of coercion variables] -addLamCoVarOccs uds bndrs - = uds `addManyOccs` coVarsOfTypes (map varType bndrs) - -delDetails :: UsageDetails -> Id -> UsageDetails -delDetails ud bndr - = ud `alterUsageDetails` (`delVarEnv` bndr) - -delDetailsList :: UsageDetails -> [Id] -> UsageDetails -delDetailsList ud bndrs - = ud `alterUsageDetails` (`delVarEnvList` bndrs) +coVarOccs bndrs + = foldr get emptyVarSet bndrs + where + get bndr cvs = (cvs `delVarSet` bndr) `unionVarSet` + coVarsOfType (varType bndr) emptyDetails :: UsageDetails emptyDetails = UD { ud_env = emptyVarEnv @@ -3187,11 +3445,16 @@ emptyDetails = UD { ud_env = emptyVarEnv isEmptyDetails :: UsageDetails -> Bool isEmptyDetails = isEmptyVarEnv . ud_env +delDetails :: UsageDetails -> [Id] -> UsageDetails +-- Delete these binders from the UsageDetails +delDetails ud bndrs = ud `alterUsageDetails` (`delVarEnvList` bndrs) + markAllMany, markAllInsideLam, markAllNonTail, markAllManyNonTail :: UsageDetails -> UsageDetails -markAllMany ud = ud { ud_z_many = ud_env ud } -markAllInsideLam ud = ud { ud_z_in_lam = ud_env ud } -markAllNonTail ud = ud { ud_z_no_tail = ud_env ud } +markAllMany ud = ud { ud_z_many = ud_env ud } +markAllInsideLam ud = ud { ud_z_in_lam = ud_env ud } +markAllNonTail ud = ud { ud_z_no_tail = ud_env ud } +markAllManyNonTail = markAllMany . markAllNonTail -- effectively sets to noOccInfo markAllInsideLamIf, markAllNonTailIf :: Bool -> UsageDetails -> UsageDetails @@ -3201,9 +3464,6 @@ markAllInsideLamIf False ud = ud markAllNonTailIf True ud = markAllNonTail ud markAllNonTailIf False ud = ud - -markAllManyNonTail = markAllMany . markAllNonTail -- effectively sets to noOccInfo - lookupDetails :: UsageDetails -> Id -> OccInfo lookupDetails ud id = case lookupVarEnv (ud_env ud) id of @@ -3213,6 +3473,15 @@ lookupDetails ud id usedIn :: Id -> UsageDetails -> Bool v `usedIn` ud = isExportedId v || v `elemVarEnv` ud_env ud +{- Commenting out + = (emptyDetails{ud_env = interesting_env}, emptyDetails{ud_env = boring_env}) + where + UD{ud_env=env} = flattenUsageDetails uds + (interesting_env,boring_env) = partitionVarEnv interesting env + interesting OneOcc{} = True + interesting _ = False +-} + udFreeVars :: VarSet -> UsageDetails -> VarSet -- Find the subset of bndrs that are mentioned in uds udFreeVars bndrs ud = restrictFreeVars bndrs (ud_env ud) @@ -3260,29 +3529,43 @@ alterUsageDetails !ud f flattenUsageDetails :: UsageDetails -> UsageDetails flattenUsageDetails ud@(UD { ud_env = env }) - = UD { ud_env = mapUFM_Directly (doZappingByUnique ud) env - , ud_z_many = emptyVarEnv - , ud_z_in_lam = emptyVarEnv - , ud_z_no_tail = emptyVarEnv } + = emptyDetails { ud_env = mapUFM_Directly (doZappingByUnique ud) env } ------------------- -- See Note [Adjusting right-hand sides] + +adjustNonRecRhs :: Maybe JoinArity + -> WithTailUsageDetails CoreExpr + -> WithUsageDetails CoreExpr +-- ^ This function concentrates shared logic between occAnalNonRecBind and the +-- AcyclicSCC case of occAnalRec. +-- * It applies 'markNonRecJoinOneShots' to the RHS +-- * and returns the adjusted rhs UsageDetails combined with the body usage +adjustNonRecRhs mb_join_arity rhs_wuds@(WTUD _ rhs) + = WUD rhs_uds' rhs' + where + --------- Marking (non-rec) join binders one-shot --------- + !rhs' | Just ja <- mb_join_arity = markNonRecJoinOneShots ja rhs + | otherwise = rhs + + --------- Adjusting right-hand side usage --------- + rhs_uds' = adjustTailUsage mb_join_arity rhs_wuds + adjustTailUsage :: Maybe JoinArity - -> CoreExpr -- Rhs, AFTER occAnalLamTail - -> TailUsageDetails -- From body of lambda - -> UsageDetails -adjustTailUsage mb_join_arity rhs (TUD rhs_ja usage) + -> WithTailUsageDetails CoreExpr -- Rhs usage, AFTER occAnalLamTail + -> UsageDetails +adjustTailUsage mb_join_arity (WTUD (TUD rhs_ja uds) rhs) = -- c.f. occAnal (Lam {}) markAllInsideLamIf (not one_shot) $ markAllNonTailIf (not exact_join) $ - usage + uds where one_shot = isOneShotFun rhs exact_join = mb_join_arity == Just rhs_ja adjustTailArity :: Maybe JoinArity -> TailUsageDetails -> UsageDetails -adjustTailArity mb_rhs_ja (TUD ud_ja usage) = - markAllNonTailIf (mb_rhs_ja /= Just ud_ja) usage +adjustTailArity mb_rhs_ja (TUD ja usage) + = markAllNonTailIf (mb_rhs_ja /= Just ja) usage markNonRecJoinOneShots :: JoinArity -> CoreExpr -> CoreExpr -- For a /non-recursive/ join point we can mark all @@ -3313,52 +3596,39 @@ markNonRecUnfoldingOneShots mb_join_arity unf type IdWithOccInfo = Id -tagLamBinders :: UsageDetails -- Of scope - -> [Id] -- Binders - -> (UsageDetails, -- Details with binders removed - [IdWithOccInfo]) -- Tagged binders +tagLamBinders :: UsageDetails -- Of scope + -> [Id] -- Binders + -> [IdWithOccInfo] -- Tagged binders tagLamBinders usage binders - = usage' `seq` (usage', bndrs') - where - (usage', bndrs') = mapAccumR tagLamBinder usage binders + = map (tagLamBinder usage) binders tagLamBinder :: UsageDetails -- Of scope -> Id -- Binder - -> (UsageDetails, -- Details with binder removed - IdWithOccInfo) -- Tagged binders + -> IdWithOccInfo -- Tagged binders -- Used for lambda and case binders --- It copes with the fact that lambda bindings can have a --- stable unfolding, used for join points +-- No-op on TyVars +-- A lambda binder never has an unfolding, so no need to look for that tagLamBinder usage bndr - = (usage2, bndr') + = setBinderOcc (markNonTail occ) bndr + -- markNonTail: don't try to make an argument into a join point where - occ = lookupDetails usage bndr - bndr' = setBinderOcc (markNonTail occ) bndr - -- Don't try to make an argument into a join point - usage1 = usage `delDetails` bndr - usage2 | isId bndr = addManyOccs usage1 (idUnfoldingVars bndr) - -- This is effectively the RHS of a - -- non-join-point binding, so it's okay to use - -- addManyOccsSet, which assumes no tail calls - | otherwise = usage1 + occ = lookupDetails usage bndr tagNonRecBinder :: TopLevelFlag -- At top level? -> UsageDetails -- Of scope -> CoreBndr -- Binder - -> WithUsageDetails -- Details with binder removed - IdWithOccInfo -- Tagged binder + -> IdWithOccInfo -- Tagged binder +-- No-op on TyVars tagNonRecBinder lvl usage binder - = let - occ = lookupDetails usage binder - will_be_join = decideJoinPointHood lvl usage (NE.singleton binder) - occ' | will_be_join = -- must already be marked AlwaysTailCalled - assert (isAlwaysTailCalled occ) occ - | otherwise = markNonTail occ - binder' = setBinderOcc occ' binder - usage' = usage `delDetails` binder - in - WithUsageDetails usage' binder' + = setBinderOcc occ' binder + where + occ = lookupDetails usage binder + will_be_join = decideJoinPointHood lvl usage (NE.singleton binder) + occ' | will_be_join = -- Must already be marked AlwaysTailCalled, unless + -- it was a join point before but is now dead + assert (isAlwaysTailCalled occ || isDeadOcc occ) occ + | otherwise = markNonTail occ tagRecBinders :: TopLevelFlag -- At top level? -> UsageDetails -- Of body of let ONLY @@ -3370,14 +3640,14 @@ tagRecBinders :: TopLevelFlag -- At top level? -- details *before* tagging binders (because the tags depend on the RHSes). tagRecBinders lvl body_uds details_s = let - bndrs = map nd_bndr details_s + bndrs = map nd_bndr details_s -- 1. See Note [Join arity prediction based on joinRhsArity] -- Determine possible join-point-hood of whole group, by testing for -- manifest join arity M. -- This (re-)asserts that makeNode had made tuds for that same arity M! - unadj_uds = foldr (andUDs . test_manifest_arity) body_uds details_s - test_manifest_arity ND{nd_rhs=WithTailUsageDetails tuds rhs} + unadj_uds = foldr (andUDs . test_manifest_arity) body_uds details_s + test_manifest_arity ND{nd_rhs = WTUD tuds rhs} = adjustTailArity (Just (joinRhsArity rhs)) tuds bndr_ne = expectNonEmpty "List of binders is never empty" bndrs @@ -3395,25 +3665,23 @@ tagRecBinders lvl body_uds details_s = Just arity | otherwise = assert (not will_be_joins) -- Should be AlwaysTailCalled if - Nothing -- we are making join points! + Nothing -- we are making join points! -- 2. Adjust usage details of each RHS, taking into account the -- join-point-hood decision - rhs_udss' = [ adjustTailUsage (mb_join_arity bndr) rhs rhs_tuds -- matching occAnalLamTail in makeNode - | ND { nd_bndr = bndr, nd_rhs = WithTailUsageDetails rhs_tuds rhs } - <- details_s ] + rhs_udss' = [ adjustTailUsage (mb_join_arity bndr) rhs_wuds + -- Matching occAnalLamTail in makeNode + | ND { nd_bndr = bndr, nd_rhs = rhs_wuds } <- details_s ] -- 3. Compute final usage details from adjusted RHS details - adj_uds = foldr andUDs body_uds rhs_udss' + adj_uds = foldr andUDs body_uds rhs_udss' -- 4. Tag each binder with its adjusted details bndrs' = [ setBinderOcc (lookupDetails adj_uds bndr) bndr | bndr <- bndrs ] - -- 5. Drop the binders from the adjusted details and return - usage' = adj_uds `delDetailsList` bndrs in - WithUsageDetails usage' bndrs' + WUD adj_uds bndrs' setBinderOcc :: OccInfo -> CoreBndr -> CoreBndr setBinderOcc occ_info bndr @@ -3444,14 +3712,21 @@ decideJoinPointHood :: TopLevelFlag -> UsageDetails -> Bool decideJoinPointHood TopLevel _ _ = False + decideJoinPointHood NotTopLevel usage bndrs - | isJoinId (NE.head bndrs) - = warnPprTrace (not all_ok) + | isJoinId bndr1 + = warnPprTrace lost_join_point "OccurAnal failed to rediscover join point(s)" (ppr bndrs) - all_ok + all_ok +-- = assertPpr (not lost_join_point) (ppr bndrs) +-- True + | otherwise = all_ok where + bndr1 = NE.head bndrs + lost_join_point = not (isDeadOcc (lookupDetails usage bndr1)) && not all_ok + -- See Note [Invariants on join points]; invariants cited by number below. -- Invariant 2 is always satisfiable by the simplifier by eta expansion. all_ok = -- Invariant 3: Either all are join points or none are ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -1065,7 +1065,7 @@ subst_id_bndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) -- See Note [Bangs in the Simplifier] !id1 = uniqAway in_scope old_id !id2 = substIdType env id1 - !id3 = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding + !id3 = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding -- and fragile OccInfo !new_id = adjust_type id3 ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -319,14 +319,14 @@ simplLazyBind :: SimplEnv -> TopLevelFlag -> RecFlag -> InId -> OutId -- Binder, both pre-and post simpl -- Not a JoinId - -- The OutId has IdInfo, except arity, unfolding + -- The OutId has IdInfo (notably RULES), + -- except arity, unfolding -- Ids only, no TyVars -> InExpr -> SimplEnv -- The RHS and its environment -> SimplM (SimplFloats, SimplEnv) -- Precondition: the OutId is already in the InScopeSet of the incoming 'env' -- Precondition: not a JoinId -- Precondition: rhs obeys the let-can-float invariant --- NOT used for JoinIds simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se = assert (isId bndr ) assertPpr (not (isJoinId bndr)) (ppr bndr) $ @@ -398,48 +398,45 @@ simplJoinBind env is_rec cont old_bndr new_bndr rhs rhs_se ; completeBind env (BC_Join is_rec cont) old_bndr new_bndr rhs' } -------------------------- -simplNonRecX :: SimplEnv +simplAuxBind :: SimplEnv -> InId -- Old binder; not a JoinId -> OutExpr -- Simplified RHS -> SimplM (SimplFloats, SimplEnv) --- A specialised variant of simplNonRec used when the RHS is already --- simplified, notably in knownCon. It uses case-binding where necessary. +-- A specialised variant of completeBindX used to construct non-recursive +-- auxiliary bindings, notably in knownCon. +-- +-- The binder comes from a case expression (case binder or alternative) +-- and so does not have rules, inline pragmas etc. -- -- Precondition: rhs satisfies the let-can-float invariant -simplNonRecX env bndr new_rhs - | assertPpr (not (isJoinId bndr)) (ppr bndr) $ +simplAuxBind env bndr new_rhs + | assertPpr (isId bndr && not (isJoinId bndr)) (ppr bndr) $ isDeadBinder bndr -- Not uncommon; e.g. case (a,b) of c { (p,q) -> p } = return (emptyFloats env, env) -- Here c is dead, and we avoid - -- creating the binding c = (a,b) - - | Coercion co <- new_rhs - = return (emptyFloats env, extendCvSubst env bndr co) + -- creating the binding c = (a,b) + -- The cases would be inlined unconditionally by completeBind: + -- but it seems not uncommon, and avoids faff to do it here + -- This is safe because it's only used for auxiliary bindings, which + -- have no NOLINE pragmas, nor RULEs | exprIsTrivial new_rhs -- Short-cut for let x = y in ... - -- This case would ultimately land in postInlineUnconditionally - -- but it seems not uncommon, and avoids a lot of faff to do it here - = return (emptyFloats env - , extendIdSubst env bndr (DoneEx new_rhs Nothing)) + = return ( emptyFloats env + , case new_rhs of + Coercion co -> extendCvSubst env bndr co + _ -> extendIdSubst env bndr (DoneEx new_rhs Nothing) ) | otherwise - = do { (env1, new_bndr) <- simplBinder env bndr - ; let is_strict = isStrictId new_bndr - -- isStrictId: use new_bndr because the InId bndr might not have - -- a fixed runtime representation, which isStrictId doesn't expect - -- c.f. Note [Dark corner with representation polymorphism] - - ; (rhs_floats, rhs1) <- prepareBinding env NotTopLevel NonRecursive is_strict - new_bndr (emptyFloats env) new_rhs - -- NB: it makes a surprisingly big difference (5% in compiler allocation - -- in T9630) to pass 'env' rather than 'env1'. It's fine to pass 'env', - -- because this is simplNonRecX, so bndr is not in scope in the RHS. - - ; (bind_float, env2) <- completeBind (env1 `setInScopeFromF` rhs_floats) - (BC_Let NotTopLevel NonRecursive) + = do { -- ANF-ise the RHS + let !occ_fs = getOccFS bndr + ; (anf_floats, rhs1) <- prepareRhs env NotTopLevel occ_fs new_rhs + ; unless (isEmptyLetFloats anf_floats) (tick LetFloatFromLet) + ; let rhs_floats = emptyFloats env `addLetFloats` anf_floats + + -- Simplify the binder and complete the binding + ; (env1, new_bndr) <- simplBinder (env `setInScopeFromF` rhs_floats) bndr + ; (bind_float, env2) <- completeBind env1 (BC_Let NotTopLevel NonRecursive) bndr new_bndr rhs1 - -- Must pass env1 to completeBind in case simplBinder had to clone, - -- and extended the substitution with [bndr :-> new_bndr] ; return (rhs_floats `addFloats` bind_float, env2) } @@ -761,49 +758,54 @@ prepareRhs :: HasDebugCallStack -- x = Just a -- See Note [prepareRhs] prepareRhs env top_lvl occ rhs0 - = do { (_is_exp, floats, rhs1) <- go 0 rhs0 - ; return (floats, rhs1) } + | is_expandable = anfise rhs0 + | otherwise = return (emptyLetFloats, rhs0) where - go :: Int -> OutExpr -> SimplM (Bool, LetFloats, OutExpr) - go n_val_args (Cast rhs co) - = do { (is_exp, floats, rhs') <- go n_val_args rhs - ; return (is_exp, floats, Cast rhs' co) } - go n_val_args (App fun (Type ty)) - = do { (is_exp, floats, rhs') <- go n_val_args fun - ; return (is_exp, floats, App rhs' (Type ty)) } - go n_val_args (App fun arg) - = do { (is_exp, floats1, fun') <- go (n_val_args+1) fun - ; if is_exp - then do { (floats2, arg') <- makeTrivial env top_lvl topDmd occ arg - ; return (True, floats1 `addLetFlts` floats2, App fun' arg') } - else return (False, emptyLetFloats, App fun arg) - } - go n_val_args (Var fun) - = return (is_exp, emptyLetFloats, Var fun) - where - is_exp = isExpandableApp fun n_val_args -- The fun a constructor or PAP - -- See Note [CONLIKE pragma] in GHC.Types.Basic - -- The definition of is_exp should match that in - -- 'GHC.Core.Opt.OccurAnal.occAnalApp' - - go n_val_args (Tick t rhs) + -- We can' use exprIsExpandable because the WHOLE POINT is that + -- we want to treat (K ) as expandable, because we are just + -- about "anfise" the expression. exprIsExpandable would + -- just say no! + is_expandable = go rhs0 0 + where + go (Var fun) n_val_args = isExpandableApp fun n_val_args + go (App fun arg) n_val_args + | isTypeArg arg = go fun n_val_args + | otherwise = go fun (n_val_args + 1) + go (Cast rhs _) n_val_args = go rhs n_val_args + go (Tick _ rhs) n_val_args = go rhs n_val_args + go _ _ = False + + anfise :: OutExpr -> SimplM (LetFloats, OutExpr) + anfise (Cast rhs co) + = do { (floats, rhs') <- anfise rhs + ; return (floats, Cast rhs' co) } + anfise (App fun (Type ty)) + = do { (floats, rhs') <- anfise fun + ; return (floats, App rhs' (Type ty)) } + anfise (App fun arg) + = do { (floats1, fun') <- anfise fun + ; (floats2, arg') <- makeTrivial env top_lvl topDmd occ arg + ; return (floats1 `addLetFlts` floats2, App fun' arg') } + anfise (Var fun) + = return (emptyLetFloats, Var fun) + + anfise (Tick t rhs) -- We want to be able to float bindings past this -- tick. Non-scoping ticks don't care. | tickishScoped t == NoScope - = do { (is_exp, floats, rhs') <- go n_val_args rhs - ; return (is_exp, floats, Tick t rhs') } + = do { (floats, rhs') <- anfise rhs + ; return (floats, Tick t rhs') } -- On the other hand, for scoping ticks we need to be able to -- copy them on the floats, which in turn is only allowed if -- we can obtain non-counting ticks. | (not (tickishCounts t) || tickishCanSplit t) - = do { (is_exp, floats, rhs') <- go n_val_args rhs + = do { (floats, rhs') <- anfise rhs ; let tickIt (id, expr) = (id, mkTick (mkNoCount t) expr) floats' = mapLetFloats floats tickIt - ; return (is_exp, floats', Tick t rhs') } + ; return (floats', Tick t rhs') } - go _ other - = return (False, emptyLetFloats, other) + anfise other = return (emptyLetFloats, other) makeTrivialArg :: HasDebugCallStack => SimplEnv -> ArgSpec -> SimplM (LetFloats, ArgSpec) makeTrivialArg env arg@(ValArg { as_arg = e, as_dmd = dmd }) @@ -1244,7 +1246,7 @@ simplExprF1 env (Let (NonRec bndr rhs) body) cont | otherwise = {-#SCC "simplNonRecE" #-} - simplNonRecE env False bndr (rhs, env) body cont + simplNonRecE env FromLet bndr (rhs, env) body cont {- Note [Avoiding space leaks in OutType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1505,8 +1507,9 @@ rebuild env expr cont StrictArg { sc_fun = fun, sc_cont = cont, sc_fun_ty = fun_ty } -> rebuildCall env (addValArgTo fun expr fun_ty ) cont - StrictBind { sc_bndr = b, sc_body = body, sc_env = se, sc_cont = cont } - -> completeBindX (se `setInScopeFromE` env) b expr body cont + StrictBind { sc_bndr = b, sc_body = body, sc_env = se + , sc_cont = cont, sc_from = from_what } + -> completeBindX (se `setInScopeFromE` env) from_what b expr body cont ApplyToTy { sc_arg_ty = ty, sc_cont = cont} -> rebuild env (App expr (Type ty)) cont @@ -1518,25 +1521,48 @@ rebuild env expr cont ; rebuild env (App expr arg') cont } completeBindX :: SimplEnv + -> FromWhat -> InId -> OutExpr -- Bind this Id to this (simplified) expression -- (the let-can-float invariant may not be satisfied) - -> InExpr -- In this lambda + -> InExpr -- In this body -> SimplCont -- Consumed by this continuation -> SimplM (SimplFloats, OutExpr) -completeBindX env bndr rhs body cont - | needsCaseBinding (idType bndr) rhs -- Enforcing the let-can-float-invariant - = do { (env1, bndr1) <- simplNonRecBndr env bndr - ; (floats, expr') <- simplLam env1 body cont +completeBindX env from_what bndr rhs body cont + | FromBeta arg_ty <- from_what + , needsCaseBinding arg_ty rhs -- Enforcing the let-can-float-invariant + = do { (env1, bndr1) <- simplNonRecBndr env bndr -- Lambda binders don't have rules + ; (floats, expr') <- simplNonRecBody env1 from_what body cont -- Do not float floats past the Case binder below ; let expr'' = wrapFloats floats expr' - ; let case_expr = Case rhs bndr1 (contResultType cont) [Alt DEFAULT [] expr''] + case_expr = Case rhs bndr1 (contResultType cont) [Alt DEFAULT [] expr''] ; return (emptyFloats env, case_expr) } - | otherwise - = do { (floats1, env') <- simplNonRecX env bndr rhs - ; (floats2, expr') <- simplLam env' body cont - ; return (floats1 `addFloats` floats2, expr') } + | otherwise -- Make a let-binding + = do { (env1, bndr1) <- simplNonRecBndr env bndr + ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) + + ; let is_strict = isStrictId bndr2 + -- isStrictId: use simplified binder because the InId bndr might not have + -- a fixed runtime representation, which isStrictId doesn't expect + -- c.f. Note [Dark corner with representation polymorphism] + + ; (rhs_floats, rhs1) <- prepareBinding env NotTopLevel NonRecursive is_strict + bndr2 (emptyFloats env) rhs + -- NB: it makes a surprisingly big difference (5% in compiler allocation + -- in T9630) to pass 'env' rather than 'env1'. It's fine to pass 'env', + -- because this is simplNonRecX, so bndr is not in scope in the RHS. + + ; (bind_float, env2) <- completeBind (env2 `setInScopeFromF` rhs_floats) + (BC_Let NotTopLevel NonRecursive) + bndr bndr2 rhs1 + -- Must pass env1 to completeBind in case simplBinder had to clone, + -- and extended the substitution with [bndr :-> new_bndr] + + -- Simplify the body + ; (body_floats, body') <- simplNonRecBody env2 from_what body cont + ; let all_floats = rhs_floats `addFloats` bind_float `addFloats` body_floats + ; return ( all_floats, body' ) } {- ************************************************************************ @@ -1674,6 +1700,14 @@ simplArg env dup_flag fun_ty arg_env arg ************************************************************************ -} +simplNonRecBody :: SimplEnv -> FromWhat + -> InExpr -> SimplCont + -> SimplM (SimplFloats, OutExpr) +simplNonRecBody env from_what body cont + = case from_what of + FromLet -> simplExprF env body cont + FromBeta {} -> simplLam env body cont + simplLam :: SimplEnv -> InExpr -> SimplCont -> SimplM (SimplFloats, OutExpr) @@ -1690,15 +1724,24 @@ simpl_lam env bndr body (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = cont }) -- Value beta-reduction simpl_lam env bndr body (ApplyToVal { sc_arg = arg, sc_env = arg_se - , sc_cont = cont, sc_dup = dup }) - | isSimplified dup -- Don't re-simplify if we've simplified it once - -- See Note [Avoiding exponential behaviour] + , sc_cont = cont, sc_dup = dup + , sc_hole_ty = fun_ty}) = do { tick (BetaReduction bndr) - ; completeBindX env bndr arg body cont } + ; let arg_ty = funArgTy fun_ty + ; if | isSimplified dup -- Don't re-simplify if we've simplified it once + -- Including don't preInlineUnconditionally + -- See Note [Avoiding exponential behaviour] + -> completeBindX env (FromBeta arg_ty) bndr arg body cont + + | Just env' <- preInlineUnconditionally env NotTopLevel bndr arg arg_se + , not (needsCaseBinding arg_ty arg) + -- Ok to test arg::InExpr in needsCaseBinding because + -- exprOkForSpeculation is stable under simplification + -> do { tick (PreInlineUnconditionally bndr) + ; simplLam env' body cont } - | otherwise -- See Note [Avoiding exponential behaviour] - = do { tick (BetaReduction bndr) - ; simplNonRecE env True bndr (arg, arg_se) body cont } + | otherwise + -> simplNonRecE env (FromBeta arg_ty) bndr (arg, arg_se) body cont } -- Discard a non-counting tick on a lambda. This may change the -- cost attribution slightly (moving the allocation of the @@ -1730,8 +1773,7 @@ simplLamBndrs env bndrs = mapAccumLM simplLamBndr env bndrs ------------------ simplNonRecE :: SimplEnv - -> Bool -- True <=> from a lambda - -- False <=> from a let + -> FromWhat -> InId -- The binder, always an Id -- Never a join point -> (InExpr, SimplEnv) -- Rhs of binding (or arg of lambda) @@ -1740,56 +1782,48 @@ simplNonRecE :: SimplEnv -> SimplM (SimplFloats, OutExpr) -- simplNonRecE is used for --- * non-top-level non-recursive non-join-point lets in expressions --- * beta reduction +-- * from=FromLet: a non-top-level non-recursive non-join-point let-expression +-- * from=FromBeta: a binding arising from a beta reduction -- --- simplNonRec env b (rhs, rhs_se) body k +-- simplNonRecE env b (rhs, rhs_se) body k -- = let env in -- cont< let b = rhs_se(rhs) in body > -- -- It deals with strict bindings, via the StrictBind continuation, -- which may abort the whole process. -- --- from_lam=False => the RHS satisfies the let-can-float invariant +-- from_what=FromLet => the RHS satisfies the let-can-float invariant -- Otherwise it may or may not satisfy it. -simplNonRecE env from_lam bndr (rhs, rhs_se) body cont - = assert (isId bndr && not (isJoinId bndr) ) $ - do { (env1, bndr1) <- simplNonRecBndr env bndr - ; let needs_case_binding = needsCaseBinding (idType bndr1) rhs - -- See Note [Dark corner with representation polymorphism] - -- If from_lam=False then needs_case_binding is False, - -- because the binding started as a let, which must - -- satisfy let-can-float - - ; if | from_lam && not needs_case_binding - -- If not from_lam we are coming from a (NonRec bndr rhs) binding - -- and preInlineUnconditionally has been done already; - -- no need to repeat it. But for lambdas we must be careful about - -- preInlineUndonditionally: consider (\(x:Int#). 3) (error "urk") - -- We must not drop the (error "urk"). - , Just env' <- preInlineUnconditionally env NotTopLevel bndr rhs rhs_se - -> do { tick (PreInlineUnconditionally bndr) - ; -- pprTrace "preInlineUncond" (ppr bndr <+> ppr rhs) $ - simplLam env' body cont } - - -- Deal with strict bindings - | isStrictId bndr1 && seCaseCase env - || from_lam && needs_case_binding - -- The important bit here is needs_case_binds; but no need to - -- test it if from_lam is False because then needs_case_binding is False too - -- NB: either way, the RHS may or may not satisfy let-can-float - -- but that's ok for StrictBind. - -> simplExprF (rhs_se `setInScopeFromE` env) rhs - (StrictBind { sc_bndr = bndr, sc_body = body - , sc_env = env, sc_cont = cont, sc_dup = NoDup }) - - -- Deal with lazy bindings - | otherwise - -> do { (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) - ; (floats1, env3) <- simplLazyBind env2 NotTopLevel NonRecursive bndr bndr2 rhs rhs_se - ; (floats2, expr') <- simplLam env3 body cont - ; return (floats1 `addFloats` floats2, expr') } } +simplNonRecE env from_what bndr (rhs, rhs_se) body cont + | assert (isId bndr && not (isJoinId bndr) ) $ + is_strict_bind + = -- Evaluate RHS strictly + simplExprF (rhs_se `setInScopeFromE` env) rhs + (StrictBind { sc_bndr = bndr, sc_body = body, sc_from = from_what + , sc_env = env, sc_cont = cont, sc_dup = NoDup }) + + | otherwise -- Evaluate RHS lazily + = do { (env1, bndr1) <- simplNonRecBndr env bndr + ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) + ; (floats1, env3) <- simplLazyBind env2 NotTopLevel NonRecursive + bndr bndr2 rhs rhs_se + ; (floats2, expr') <- simplNonRecBody env3 from_what body cont + ; return (floats1 `addFloats` floats2, expr') } + + where + is_strict_bind = case from_what of + FromBeta arg_ty | isUnliftedType arg_ty -> True + -- If we are coming from a beta-reduction (FromBeta) we must + -- establish the let-can-float invariant, so go via StrictBind + -- If not, the invariant holds already, and it's optional. + -- Using arg_ty: see Note [Dark corner with representation polymorphism] + -- e.g (\r \(a::TYPE r) \(x::a). blah) @LiftedRep @Int arg + -- When we come to `x=arg` we myst choose lazy/strict correctly + -- It's wrong to err in either directly + + _ -> seCaseCase env && isStrUsedDmd (idDemandInfo bndr) + ------------------ simplRecE :: SimplEnv @@ -1835,7 +1869,7 @@ Note [Avoiding exponential behaviour] One way in which we can get exponential behaviour is if we simplify a big expression, and then re-simplify it -- and then this happens in a deeply-nested way. So we must be jolly careful about re-simplifying -an expression. That is why simplNonRecX does not try +an expression (#13379). That is why simplNonRecX does not try preInlineUnconditionally (unlike simplNonRecE). Example: @@ -2618,15 +2652,10 @@ Is this inefficient? Not really: we are about to walk over the result of the rule firing to simplify it, so occurrence analysis is at most a constant factor. -Possible improvement: occ-anal the rules when putting them in the -database; and in the simplifier just occ-anal the OutExpr arguments. -But that's more complicated and the rule RHS is usually tiny; so I'm -just doing the simple thing. - -Historical note: previously we did occ-anal the rules in Rule.hs, -but failed to occ-anal the OutExpr arguments, which led to the -nasty performance problem described above. - +Note, however, that the rule RHS is /already/ occ-analysed; see +Note [OccInfo in unfoldings and rules] in GHC.Core. There is something +unsatisfactory about doing it twice; but the rule RHS is usually very +small, and this is simple. Note [Optimising tagToEnum#] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2930,7 +2959,7 @@ rebuildCase env scrut case_bndr alts cont where simple_rhs env wfloats case_bndr_rhs bs rhs = assert (null bs) $ - do { (floats1, env') <- simplNonRecX env case_bndr case_bndr_rhs + do { (floats1, env') <- simplAuxBind env case_bndr case_bndr_rhs -- scrut is a constructor application, -- hence satisfies let-can-float invariant ; (floats2, expr') <- simplExprF env' rhs cont @@ -2997,7 +3026,7 @@ rebuildCase env scrut case_bndr alts@[Alt _ bndrs rhs] cont | all_dead_bndrs , doCaseToLet scrut case_bndr = do { tick (CaseElim case_bndr) - ; (floats1, env') <- simplNonRecX env case_bndr scrut + ; (floats1, env') <- simplAuxBind env case_bndr scrut ; (floats2, expr') <- simplExprF env' rhs cont ; return (floats1 `addFloats` floats2, expr') } @@ -3483,12 +3512,11 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont bind_args env' (b:bs') (arg : args) = assert (isId b) $ do { let b' = zap_occ b - -- Note that the binder might be "dead", because it doesn't - -- occur in the RHS; and simplNonRecX may therefore discard - -- it via postInlineUnconditionally. + -- zap_occ: the binder might be "dead", because it doesn't + -- occur in the RHS; and simplAuxBind may therefore discard it. -- Nevertheless we must keep it if the case-binder is alive, -- because it may be used in the con_app. See Note [knownCon occ info] - ; (floats1, env2) <- simplNonRecX env' b' arg -- arg satisfies let-can-float invariant + ; (floats1, env2) <- simplAuxBind env' b' arg -- arg satisfies let-can-float invariant ; (floats2, env3) <- bind_args env2 bs' args ; return (floats1 `addFloats` floats2, env3) } @@ -3514,7 +3542,7 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont ; let con_app = Var (dataConWorkId dc) `mkTyApps` dc_ty_args `mkApps` dc_args - ; simplNonRecX env bndr con_app } + ; simplAuxBind env bndr con_app } ------------------- missingAlt :: SimplEnv -> Id -> [InAlt] -> SimplCont @@ -3621,15 +3649,15 @@ mkDupableContWithDmds env dmds (TickIt t cont) ; return (floats, TickIt t cont') } mkDupableContWithDmds env _ - (StrictBind { sc_bndr = bndr, sc_body = body + (StrictBind { sc_bndr = bndr, sc_body = body, sc_from = from_what , sc_env = se, sc_cont = cont}) -- See Note [Duplicating StrictBind] -- K[ let x = <> in b ] --> join j x = K[ b ] -- j <> = do { let sb_env = se `setInScopeFromE` env ; (sb_env1, bndr') <- simplBinder sb_env bndr - ; (floats1, join_inner) <- simplLam sb_env1 body cont - -- No need to use mkDupableCont before simplLam; we + ; (floats1, join_inner) <- simplNonRecBody sb_env1 from_what body cont + -- No need to use mkDupableCont before simplNonRecBody; we -- use cont once here, and then share the result if necessary ; let join_body = wrapFloats floats1 join_inner @@ -3757,6 +3785,7 @@ mkDupableStrictBind env arg_bndr join_rhs res_ty , StrictBind { sc_bndr = arg_bndr , sc_body = join_rhs , sc_env = zapSubstEnv env + , sc_from = FromLet -- See Note [StaticEnv invariant] in GHC.Core.Opt.Simplify.Utils , sc_dup = OkToDup , sc_cont = mkBoringStop res_ty } ) @@ -4430,7 +4459,9 @@ simplRules env mb_new_id rules bind_cxt ; return (rule { ru_bndrs = bndrs' , ru_fn = fn_name' , ru_args = args' - , ru_rhs = rhs' }) } + , ru_rhs = occurAnalyseExpr rhs' }) } + -- Remember to occ-analyse, to drop dead code. + -- See Note [OccInfo in unfoldings and rules] in GHC.Core {- Note [Simplifying the RHS of a RULE] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -21,7 +21,7 @@ module GHC.Core.Opt.Simplify.Utils ( BindContext(..), bindContextLevel, -- The continuation type - SimplCont(..), DupFlag(..), StaticEnv, + SimplCont(..), DupFlag(..), FromWhat(..), StaticEnv, isSimplified, contIsStop, contIsDupable, contResultType, contHoleType, contHoleScaling, contIsTrivial, contArgs, contIsRhs, @@ -192,6 +192,7 @@ data SimplCont -- or, equivalently, = K[ (\x.b) e ] { sc_dup :: DupFlag -- See Note [DupFlag invariants] , sc_bndr :: InId + , sc_from :: FromWhat , sc_body :: InExpr , sc_env :: StaticEnv -- See Note [StaticEnv invariant] , sc_cont :: SimplCont } @@ -213,6 +214,8 @@ data SimplCont type StaticEnv = SimplEnv -- Just the static part is relevant +data FromWhat = FromLet | FromBeta OutType + -- See Note [DupFlag invariants] data DupFlag = NoDup -- Unsimplified, might be big | Simplified -- Simplified ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -63,6 +63,7 @@ import GHC.Core.Tidy ( tidyRules ) import GHC.Core.Map.Expr ( eqCoreExpr ) import GHC.Core.Opt.Arity( etaExpandToJoinPointRule ) import GHC.Core.Make ( mkCoreLams ) +import GHC.Core.Opt.OccurAnal( occurAnalyseExpr ) import GHC.Tc.Utils.TcType ( tcSplitTyConApp_maybe ) import GHC.Builtin.Types ( anyTypeOfKind ) @@ -189,13 +190,18 @@ mkRule :: Module -> Bool -> Bool -> RuleName -> Activation -- ^ Used to make 'CoreRule' for an 'Id' defined in the module being -- compiled. See also 'GHC.Core.CoreRule' mkRule this_mod is_auto is_local name act fn bndrs args rhs - = Rule { ru_name = name, ru_fn = fn, ru_act = act, - ru_bndrs = bndrs, ru_args = args, - ru_rhs = rhs, - ru_rough = roughTopNames args, - ru_origin = this_mod, - ru_orphan = orph, - ru_auto = is_auto, ru_local = is_local } + = Rule { ru_name = name + , ru_act = act + , ru_fn = fn + , ru_bndrs = bndrs + , ru_args = args + , ru_rhs = occurAnalyseExpr rhs + -- See Note [OccInfo in unfoldings and rules] + , ru_rough = roughTopNames args + , ru_origin = this_mod + , ru_orphan = orph + , ru_auto = is_auto + , ru_local = is_local } where -- Compute orphanhood. See Note [Orphans] in GHC.Core.InstEnv -- A rule is an orphan only if none of the variables ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -513,8 +513,8 @@ bindNonRec bndr rhs body -- | Tests whether we have to use a @case@ rather than @let@ binding for this -- expression as per the invariants of 'CoreExpr': see "GHC.Core#let_can_float_invariant" needsCaseBinding :: Type -> CoreExpr -> Bool -needsCaseBinding ty rhs = - mightBeUnliftedType ty && not (exprOkForSpeculation rhs) +needsCaseBinding ty rhs + = mightBeUnliftedType ty && not (exprOkForSpeculation rhs) -- Make a case expression instead of a let -- These can arise either from the desugarer, -- or from beta reductions: (\x.e) (x +# y) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4939,6 +4939,7 @@ needSourceNotes dflags = debugLevel dflags > 0 -- LinkerInfo contains any extra options needed by the system linker. data LinkerInfo = GnuLD [Option] + | Mold [Option] | GnuGold [Option] | LlvmLLD [Option] | DarwinLD [Option] ===================================== compiler/GHC/SysTools/Info.hs ===================================== @@ -70,6 +70,7 @@ The flag is only needed on ELF systems. On Windows (PE) and Mac OS X neededLinkArgs :: LinkerInfo -> [Option] neededLinkArgs (GnuLD o) = o +neededLinkArgs (Mold o) = o neededLinkArgs (GnuGold o) = o neededLinkArgs (LlvmLLD o) = o neededLinkArgs (DarwinLD o) = o @@ -106,6 +107,10 @@ getLinkerInfo' logger dflags = do -- see Note [ELF needed shared libs] "-Wl,--no-as-needed"]) + | any ("mold" `isPrefixOf`) stdo = + return (Mold $ map Option [ --see Note [ELF needed shared libs] + "-Wl,--no-as-needed"]) + | any ("GNU gold" `isPrefixOf`) stdo = -- GNU gold only needs --no-as-needed. #10110. -- ELF specific flag, see Note [ELF needed shared libs] ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -723,12 +723,14 @@ setIdCprSig id sig = modifyIdInfo (\info -> setCprSigInfo info sig) id zapIdDmdSig :: Id -> Id zapIdDmdSig id = modifyIdInfo (`setDmdSigInfo` nopSig) id --- | This predicate says whether the 'Id' has a strict demand placed on it or --- has a type such that it can always be evaluated strictly (i.e an --- unlifted type, as of GHC 7.6). We need to --- check separately whether the 'Id' has a so-called \"strict type\" because if --- the demand for the given @id@ hasn't been computed yet but @id@ has a strict --- type, we still want @isStrictId id@ to be @True at . +-- | `isStrictId` says whether either +-- (a) the 'Id' has a strict demand placed on it or +-- (b) definitely has a \"strict type\", such that it can always be +-- evaluated strictly (i.e an unlifted type) +-- We need to check (b) as well as (a), because when the demand for the +-- given `id` hasn't been computed yet but `id` has a strict +-- type, we still want `isStrictId id` to be `True`. +-- Returns False if the type is levity polymorphic; False is always safe. isStrictId :: Id -> Bool isStrictId id | assertPpr (isId id) (text "isStrictId: not an id: " <+> ppr id) $ ===================================== compiler/GHC/Types/Unique/FM.hs ===================================== @@ -68,7 +68,7 @@ module GHC.Types.Unique.FM ( nonDetStrictFoldUFM_Directly, anyUFM, allUFM, seqEltsUFM, mapUFM, mapUFM_Directly, - mapMaybeUFM, + mapMaybeUFM, mapMaybeUFM_Directly, elemUFM, elemUFM_Directly, filterUFM, filterUFM_Directly, partitionUFM, sizeUFM, @@ -362,11 +362,14 @@ foldUFM k z (UFM m) = M.foldr k z m mapUFM :: (elt1 -> elt2) -> UniqFM key elt1 -> UniqFM key elt2 mapUFM f (UFM m) = UFM (M.map f m) +mapUFM_Directly :: (Unique -> elt1 -> elt2) -> UniqFM key elt1 -> UniqFM key elt2 +mapUFM_Directly f (UFM m) = UFM (M.mapWithKey (f . getUnique) m) + mapMaybeUFM :: (elt1 -> Maybe elt2) -> UniqFM key elt1 -> UniqFM key elt2 mapMaybeUFM f (UFM m) = UFM (M.mapMaybe f m) -mapUFM_Directly :: (Unique -> elt1 -> elt2) -> UniqFM key elt1 -> UniqFM key elt2 -mapUFM_Directly f (UFM m) = UFM (M.mapWithKey (f . getUnique) m) +mapMaybeUFM_Directly :: (Unique -> elt1 -> Maybe elt2) -> UniqFM key elt1 -> UniqFM key elt2 +mapMaybeUFM_Directly f (UFM m) = UFM (M.mapMaybeWithKey (f . getUnique) m) filterUFM :: (elt -> Bool) -> UniqFM key elt -> UniqFM key elt filterUFM p (UFM m) = UFM (M.filter p m) ===================================== compiler/GHC/Unit/Module/ModIface.hs ===================================== @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE NamedFieldPuns #-} module GHC.Unit.Module.ModIface ( ModIface @@ -549,20 +550,58 @@ emptyIfaceHashCache _occ = Nothing -- Take care, this instance only forces to the degree necessary to -- avoid major space leaks. -instance (NFData (IfaceBackendExts (phase :: ModIfacePhase)), NFData (IfaceDeclExts (phase :: ModIfacePhase))) => NFData (ModIface_ phase) where - rnf (ModIface f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 - f13 f14 f15 f16 f17 f18 f19 f20 f21 f22 f23 f24) = - rnf f1 `seq` rnf f2 `seq` f3 `seq` f4 `seq` f5 `seq` f6 `seq` rnf f7 `seq` f8 `seq` - f9 `seq` rnf f10 `seq` rnf f11 `seq` rnf f12 `seq` f13 `seq` rnf f14 `seq` rnf f15 `seq` rnf f16 `seq` - rnf f17 `seq` f18 `seq` rnf f19 `seq` rnf f20 `seq` rnf f21 `seq` f22 `seq` f23 `seq` rnf f24 +instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase)) + , NFData (IfaceDeclExts (phase :: ModIfacePhase)) + ) => NFData (ModIface_ phase) where + rnf (ModIface{ mi_module, mi_sig_of, mi_hsc_src, mi_deps, mi_usages + , mi_exports, mi_used_th, mi_fixities, mi_warns, mi_anns + , mi_decls, mi_extra_decls, mi_globals, mi_insts + , mi_fam_insts, mi_rules, mi_hpc, mi_trust, mi_trust_pkg + , mi_complete_matches, mi_docs, mi_final_exts + , mi_ext_fields, mi_src_hash}) + = rnf mi_module + `seq` rnf mi_sig_of + `seq` mi_hsc_src + `seq` mi_deps + `seq` mi_usages + `seq` mi_exports + `seq` rnf mi_used_th + `seq` mi_fixities + `seq` mi_warns + `seq` rnf mi_anns + `seq` rnf mi_decls + `seq` rnf mi_extra_decls + `seq` mi_globals + `seq` rnf mi_insts + `seq` rnf mi_fam_insts + `seq` rnf mi_rules + `seq` rnf mi_hpc + `seq` mi_trust + `seq` rnf mi_trust_pkg + `seq` rnf mi_complete_matches + `seq` rnf mi_docs + `seq` mi_final_exts + `seq` mi_ext_fields + `seq` rnf mi_src_hash `seq` () - instance NFData (ModIfaceBackend) where - rnf (ModIfaceBackend f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13) - = rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` - rnf f5 `seq` rnf f6 `seq` rnf f7 `seq` rnf f8 `seq` - rnf f9 `seq` rnf f10 `seq` rnf f11 `seq` rnf f12 `seq` rnf f13 + rnf (ModIfaceBackend{ mi_iface_hash, mi_mod_hash, mi_flag_hash, mi_opt_hash + , mi_hpc_hash, mi_plugin_hash, mi_orphan, mi_finsts, mi_exp_hash + , mi_orphan_hash, mi_warn_fn, mi_fix_fn, mi_hash_fn}) + = rnf mi_iface_hash + `seq` rnf mi_mod_hash + `seq` rnf mi_flag_hash + `seq` rnf mi_opt_hash + `seq` rnf mi_hpc_hash + `seq` rnf mi_plugin_hash + `seq` rnf mi_orphan + `seq` rnf mi_finsts + `seq` rnf mi_exp_hash + `seq` rnf mi_orphan_hash + `seq` rnf mi_warn_fn + `seq` rnf mi_fix_fn + `seq` rnf mi_hash_fn forceModIface :: ModIface -> IO () ===================================== libraries/base/Data/OldList.hs ===================================== @@ -1511,7 +1511,7 @@ sortOn :: Ord b => (a -> b) -> [a] -> [a] sortOn f = map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x)) --- | Produce singleton list. +-- | Construct a list from a single element. -- -- >>> singleton True -- [True] ===================================== libraries/base/tests/all.T ===================================== @@ -79,7 +79,9 @@ test('length001', # excessive amounts of stack space. So we specifically set a low # stack limit and mark it as failing under a few conditions. [extra_run_opts('+RTS -K8m -RTS'), - expect_fail_for(['normal', 'threaded1', 'llvm', 'nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc'])], + expect_fail_for(['normal', 'threaded1', 'llvm', 'nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc']), + # JS doesn't support stack limit so the test sometimes passes just fine. We decrease the timeout duration to force the failure. + when(js_arch(), run_timeout_multiplier(0.2))], compile_and_run, ['']) test('ratio001', normal, compile_and_run, ['']) ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -31,6 +31,7 @@ module Language.Haskell.TH.Syntax -- $infix ) where +import qualified Data.Fixed as Fixed import Data.Data hiding (Fixity(..)) import Data.IORef import System.IO.Unsafe ( unsafePerformIO ) @@ -1056,6 +1057,15 @@ instance Lift Natural where liftTyped x = unsafeCodeCoerce (lift x) lift x = return (LitE (IntegerL (fromIntegral x))) +instance Lift (Fixed.Fixed a) where + liftTyped x = unsafeCodeCoerce (lift x) + lift (Fixed.MkFixed x) = do + ex <- lift x + return (ConE mkFixedName `AppE` ex) + where + mkFixedName = + mkNameG DataName "base" "Data.Fixed" "MkFixed" + instance Integral a => Lift (Ratio a) where liftTyped x = unsafeCodeCoerce (lift x) lift x = return (LitE (RationalL (toRational x))) ===================================== libraries/template-haskell/changelog.md ===================================== @@ -7,6 +7,7 @@ * Add `TypeDataD` constructor to the `Dec` type for `type data` declarations (GHC proposal #106). + * Add `instance Lift (Fixed a)` ## 2.19.0.0 ===================================== testsuite/driver/testlib.py ===================================== @@ -129,14 +129,17 @@ def no_deps( name, opts): def skip( name, opts ): opts.skip = True +def js_arch() -> bool: + return arch("javascript"); + # disable test on JS arch def js_skip( name, opts ): - if arch("javascript"): + if js_arch(): skip(name,opts) # expect broken for the JS backend def js_broken( bug: IssueNumber ): - if arch("javascript"): + if js_arch(): return expect_broken(bug); else: return normal; ===================================== testsuite/tests/simplCore/should_compile/T22761.hs ===================================== @@ -0,0 +1,40 @@ +module T22761 where + +import T22761a + +newtype Mod m = Mod m deriving Num + +gcdExt :: Integer -> (Integer, Integer) +gcdExt x = go 0 x + where + go !_ 0 = (1, 1) + go r _ = go r r + +pow :: (Num m) => Mod m -> Mod m +pow x = x*x*x +{-# NOINLINE [1] pow #-} +{-# RULES +"powMod/3/Int" forall x. pow x = x*x*x +#-} + + +-- GHC puts `boo1` after `wom1` (since they don't appear connected) +-- Then { wom1 = foo True } rewrites to { wom1 = boo False } +-- so we need to do glomming. And that triggers the bug +-- in the RULE for `pow`! +-- +-- wom2/boo2 are there to still elicit the bug if +-- GHC reverses its default ordering + +{-# RULES +"wombat1" foo True = boo1 False +#-} + +wom1 = foo True +boo1 x = x + +{-# RULES +"wombat2" foo True = boo2 False +#-} +boo2 x = x +wom2 = foo True ===================================== testsuite/tests/simplCore/should_compile/T22761a.hs ===================================== @@ -0,0 +1,4 @@ +module T22761a where + +{-# NOINLINE [0] foo #-} +foo x = x ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -471,5 +471,6 @@ test('T22611', [when(wordsize(32), skip), grep_errmsg(r'\$salterF') ], compile, test('T22715_2', normal, multimod_compile, ['T22715_2', '-v0 -O -fspecialise-aggressively']) test('T22802', normal, compile, ['-O']) test('T15205', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) +test('T22761', normal, multimod_compile, ['T22761', '-O2 -v0']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/626ea35bbc51f7ce1a63f6b8fa6aff49539307b4...66c44df2b01fc5ba27e17991caaf1e84c4746b8b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/626ea35bbc51f7ce1a63f6b8fa6aff49539307b4...66c44df2b01fc5ba27e17991caaf1e84c4746b8b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Feb 11 02:11:11 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Fri, 10 Feb 2023 21:11:11 -0500 Subject: [Git][ghc/ghc][wip/T22948] Don't generate datacon wrappers for `type data` declarations Message-ID: <63e6f93f6fae0_50c525260c92121@gitlab.mail> Ryan Scott pushed to branch wip/T22948 at Glasgow Haskell Compiler / GHC Commits: 28b499e5 by Ryan Scott at 2023-02-10T21:10:36-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 7 changed files: - compiler/GHC/Core/Utils.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Types/Id/Make.hs - + testsuite/tests/type-data/should_compile/T22948b.hs - testsuite/tests/type-data/should_compile/all.T - + testsuite/tests/type-data/should_run/T22948a.hs - testsuite/tests/type-data/should_run/all.T Changes: ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -728,9 +728,8 @@ refineDefaultAlt :: [Unique] -- ^ Uniques for constructing new binders refineDefaultAlt us mult tycon tys imposs_deflt_cons all_alts | Alt DEFAULT _ rhs : rest_alts <- all_alts , isAlgTyCon tycon -- It's a data type, tuple, or unboxed tuples. - , not (isNewTyCon tycon) -- We can have a newtype, if we are just doing an eval: - -- case x of { DEFAULT -> e } - -- and we don't want to fill in a default for them! + , not (isNewTyCon tycon) -- Exception 1 in Note [Refine DEFAULT case alternatives] + , not (isTypeDataTyCon tycon) -- Exception 2 in Note [Refine DEFAULT case alternatives] , Just all_cons <- tyConDataCons_maybe tycon , let imposs_data_cons = mkUniqSet [con | DataAlt con <- imposs_deflt_cons] -- We now know it's a data type, so we can use @@ -815,6 +814,39 @@ with a specific constructor is desirable. `imposs_deflt_cons` argument is populated with constructors which are matched elsewhere. +There are two exceptions where we avoid refining a DEFAULT case: + +* Exception 1: Newtypes + + We can have a newtype, if we are just doing an eval: + + case x of { DEFAULT -> e } + + And we don't want to fill in a default for them! + +* Exception 2: `type data` declarations + + The data constructors for a `type data` declaration (see + Note [Type data declarations] in GHC.Rename.Module) do not exist at the + value level. Nevertheless, it is possible to strictly evaluate a value + whose type is a `type data` declaration. Test case + type-data/should_compile/T2294b.hs contains an example: + + type data T a where + A :: T Int + + f :: T a -> () + f !x = () + + We want to generate the following Core for f: + + f = \(@a) (x :: T a) -> + case x of + __DEFAULT -> () + + Namely, we do _not_ want to match on `A`, as it doesn't exist at the value + level! + Note [Combine identical alternatives] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If several alternatives are identical, merge them into a single ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -2132,6 +2132,20 @@ The main parts of the implementation are: `type data` declarations. When these are converted back to Hs types in a splice, the constructors are placed in the TcCls namespace. +* A `type data` declaration _never_ generates wrappers for its data + constructors, as they only make sense for value-level data constructors. + This extends to `type data` declarations implemented as GADTs, such as + this example from #22948: + + type data T a where + A :: T Int + B :: T a + + If `T` were an ordinary `data` declaration, then `A` would have a wrapper + to account for the GADT-like equality in its return type. Because `T` is + declared as a `type data` declaration, however, the wrapper is omitted. + See `wrapped_reqd` in GHC.Types.Id.Make.mkDataConRep` for the place where + this check is implemented. -} warnNoDerivStrat :: Maybe (LDerivStrategy GhcRn) ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -789,6 +789,10 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con (unboxers, boxers) = unzip wrappers (rep_tys, rep_strs) = unzip (concat rep_tys_w_strs) + -- This is True if the data constructor or class dictionary constructor + -- needs a wrapper. This wrapper is injected into the program later in the + -- CoreTidy pass. See Note [Injecting implicit bindings] in GHC.Iface.Tidy, + -- along with the accompanying implementation in getTyConImplicitBinds. wrapper_reqd = (not new_tycon -- (Most) newtypes have only a worker, with the exception @@ -796,13 +800,27 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con && (any isBanged (ev_ibangs ++ arg_ibangs))) -- Some forcing/unboxing (includes eq_spec) || isFamInstTyCon tycon -- Cast result - || dataConUserTyVarsNeedWrapper data_con + || (dataConUserTyVarsNeedWrapper data_con -- If the data type was written with GADT syntax and -- orders the type variables differently from what the -- worker expects, it needs a data con wrapper to reorder -- the type variables. - -- See Note [Data con wrappers and GADT syntax]. - -- NB: All GADTs return true from this function + -- + -- NB: All GADTs return true from this function, but there + -- is one exception that we must check below. + && not (isTypeDataTyCon tycon)) + -- An exception to this rule is `type data` declarations. + -- Their data constructors only live at the type level and + -- therefore do not need wrappers. + -- See Note [Type data declarations] in GHC.Rename.Module. + -- + -- Note that the other checks in this definition will + -- return False for `type data` declarations, as: + -- + -- - They cannot be newtypes + -- - They cannot have strict fields + -- - They cannot be data family instances + -- - They cannot have datatype contexts || not (null stupid_theta) -- If the data constructor has a datatype context, -- we need a wrapper in order to drop the stupid arguments. ===================================== testsuite/tests/type-data/should_compile/T22948b.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeData #-} +module T22948b where + +type data T a where + A :: T Int + +f :: T a -> () +f !x = () ===================================== testsuite/tests/type-data/should_compile/all.T ===================================== @@ -5,3 +5,4 @@ test('TDGoodConsConstraints', normal, compile, ['']) test('TDVector', normal, compile, ['']) test('TD_TH_splice', js_broken(22576), compile, ['']) test('T22315a', [extra_files(['T22315a/'])], multimod_compile, ['T22315a.Lib T22315a.Main', '-v0']) +test('T22948b', normal, compile, ['']) ===================================== testsuite/tests/type-data/should_run/T22948a.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeData #-} +module Main where + +type data T a where + A :: T Int + B :: T a + +main = return () ===================================== testsuite/tests/type-data/should_run/all.T ===================================== @@ -1,3 +1,4 @@ test('T22332a', exit_code(1), compile_and_run, ['']) test('T22315b', extra_files(['T22315b.hs']), ghci_script, ['T22315b.script']) test('T22500', normal, compile_and_run, ['']) +test('T22948a', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/28b499e59c6341e82644a8a6975a88c727141aef -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/28b499e59c6341e82644a8a6975a88c727141aef You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Feb 11 14:32:12 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sat, 11 Feb 2023 09:32:12 -0500 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] Enable 32bit testing of stack_misc_closures Message-ID: <63e7a6ecbda0e_50c52526e8139983@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: 32e581a8 by Sven Tennie at 2023-02-11T14:30:54+00:00 Enable 32bit testing of stack_misc_closures - - - - - 2 changed files: - libraries/ghc-heap/tests/stack_misc_closures.hs - libraries/ghc-heap/tests/stack_misc_closures_c.c Changes: ===================================== libraries/ghc-heap/tests/stack_misc_closures.hs ===================================== @@ -63,6 +63,8 @@ foreign import prim "any_underflow_framezh" any_underflow_frame# :: SetupFunctio foreign import ccall "maxSmallBitmapBits" maxSmallBitmapBits_c :: Word +foreign import ccall "bitsInWord" bitsInWord :: Word + foreign import ccall "belchStack" belchStack# :: StackSnapshot# -> IO () {- Test stategy @@ -226,13 +228,13 @@ main = do RetBig {..} -> do assertEqual (tipe info) RET_BIG pCs <- mapM getBoxedClosureData payload - let closureCount = 64 + 1 + let closureCount = fromIntegral $ bitsInWord + 1 assertEqual (length pCs) closureCount let wds = map getWordFromConstr01 pCs assertEqual wds [1 .. (fromIntegral closureCount)] e -> error $ "Wrong closure type: " ++ show e traceM $ "Test 24" - testSize any_ret_big_closures_two_words_frame# (64 + 1 + 1) + testSize any_ret_big_closures_two_words_frame# ((fromIntegral bitsInWord) + 1 + 1) traceM $ "Test 25" test any_ret_fun_arg_n_prim_framezh# $ \case ===================================== libraries/ghc-heap/tests/stack_misc_closures_c.c ===================================== @@ -94,6 +94,8 @@ void create_any_ret_small_closure_frame(Capability *cap, StgStack *stack, StgWord maxSmallBitmapBits() { return MAX_SMALL_BITMAP_BITS; } +StgWord bitsInWord() { return BITS_IN(W_); } + RTS_RET(test_small_ret_full_p); void create_any_ret_small_closures_frame(Capability *cap, StgStack *stack, StgWord w) { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/32e581a85cf92cde93ad1ca424f8f61eafbd3a96 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/32e581a85cf92cde93ad1ca424f8f61eafbd3a96 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Feb 11 23:37:13 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Sat, 11 Feb 2023 18:37:13 -0500 Subject: [Git][ghc/ghc][wip/T22948] Treat type data declarations as empty when checking pattern-matching coverage Message-ID: <63e826a9516a8_50c52526fc1895af@gitlab.mail> Ryan Scott pushed to branch wip/T22948 at Glasgow Haskell Compiler / GHC Commits: 78dc538f by Ryan Scott at 2023-02-11T18:35:05-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - 4 changed files: - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/Rename/Module.hs - + testsuite/tests/pmcheck/should_compile/T22964.hs - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -146,11 +146,16 @@ updRcm f (RCM vanilla pragmas) -- Ex.: @vanillaCompleteMatchTC 'Maybe' ==> Just ("Maybe", {'Just','Nothing'})@ vanillaCompleteMatchTC :: TyCon -> Maybe CompleteMatch vanillaCompleteMatchTC tc = - let -- TYPE acts like an empty data type on the term-level (#14086), but - -- it is a PrimTyCon, so tyConDataCons_maybe returns Nothing. Hence a - -- special case. - mb_dcs | tc == tYPETyCon = Just [] - | otherwise = tyConDataCons_maybe tc + let mb_dcs | -- TYPE acts like an empty data type on the term level (#14086), + -- but it is a PrimTyCon, so tyConDataCons_maybe returns Nothing. + -- Hence a special case. + tc == tYPETyCon = Just [] + | -- Similarly, treat `type data` declarations as empty data types on + -- the term level, as `type data` data constructors only exist at + -- the type level (#22964). + -- See Note [Type data declarations] in GHC.Rename.Module. + isTypeDataTyCon tc = Just [] + | otherwise = tyConDataCons_maybe tc in vanillaCompleteMatch . mkUniqDSet . map RealDataCon <$> mb_dcs -- | Initialise from 'dsGetCompleteMatches' (containing all COMPLETE pragmas) ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -2146,6 +2146,21 @@ The main parts of the implementation are: declared as a `type data` declaration, however, the wrapper is omitted. See `wrapped_reqd` in GHC.Types.Id.Make.mkDataConRep` for the place where this check is implemented. + +* Although `type data` data constructors do not exist at the value level, + it is still possible to match on a value whose type is headed by a `type data` + type constructor, such as this example from #22964: + + type data T a where + A :: T Int + B :: T a + + f :: T a -> () + f x = case x of {} + + During checking the coverage of `f`'s pattern matches, we treat `T` as if it + were an empty data type so that GHC does not warn the user to match against + `A` or `B`. -} warnNoDerivStrat :: Maybe (LDerivStrategy GhcRn) ===================================== testsuite/tests/pmcheck/should_compile/T22964.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE TypeData #-} +module X where + +type data T1 a where + A1 :: T1 Int + B1 :: T1 a + +f1 :: T1 a -> () +f1 x = case x of {} + +type data T2 a where + A2 :: T2 Int + +f2 :: T2 a -> () +f2 x = case x of {} ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -158,3 +158,4 @@ test('EmptyCase009', [], compile, [overlapping_incomplete]) test('EmptyCase010', [], compile, [overlapping_incomplete]) test('T19271', [], compile, [overlapping_incomplete]) test('T21761', [], compile, [overlapping_incomplete]) +test('T22964', [], compile, [overlapping_incomplete]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/78dc538f31dd54f47f956e1ca66b75ce8251dc1c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/78dc538f31dd54f47f956e1ca66b75ce8251dc1c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Feb 12 08:32:33 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sun, 12 Feb 2023 03:32:33 -0500 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] 2 commits: Cleanup Message-ID: <63e8a42140050_50c521bff59a421269f@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: a98f1e6b by Sven Tennie at 2023-02-11T14:39:02+00:00 Cleanup - - - - - a440f513 by Sven Tennie at 2023-02-12T08:32:00+00:00 Fix ERW_ - - - - - 3 changed files: - libraries/ghc-heap/tests/TestUtils.hs - libraries/ghc-heap/tests/stack_misc_closures.hs - rts/include/Stg.h Changes: ===================================== libraries/ghc-heap/tests/TestUtils.hs ===================================== @@ -43,7 +43,7 @@ assertThat :: (HasCallStack, Monad m) => String -> (a -> Bool) -> a -> m () assertThat s f a = if f a then pure () else error s assertStackInvariants :: (HasCallStack, MonadIO m) => StackSnapshot -> [Closure] -> m () -assertStackInvariants stack decodedStack = do +assertStackInvariants stack decodedStack = assertThat "Last frame is stop frame" ( \case ===================================== libraries/ghc-heap/tests/stack_misc_closures.hs ===================================== @@ -12,9 +12,8 @@ module Main where --- TODO: Remove later - import Data.Functor +-- TODO: Remove later import Debug.Trace import GHC.Exts import GHC.Exts.DecodeStack @@ -51,11 +50,11 @@ foreign import prim "any_ret_big_closures_min_framezh" any_ret_big_closures_min_ foreign import prim "any_ret_big_closures_two_words_framezh" any_ret_big_closures_two_words_frame# :: SetupFunction -foreign import prim "any_ret_fun_arg_n_prim_framezh" any_ret_fun_arg_n_prim_framezh# :: SetupFunction +foreign import prim "any_ret_fun_arg_n_prim_framezh" any_ret_fun_arg_n_prim_frame# :: SetupFunction -foreign import prim "any_ret_fun_arg_gen_framezh" any_ret_fun_arg_gen_framezh# :: SetupFunction +foreign import prim "any_ret_fun_arg_gen_framezh" any_ret_fun_arg_gen_frame# :: SetupFunction -foreign import prim "any_ret_fun_arg_gen_big_framezh" any_ret_fun_arg_gen_big_framezh# :: SetupFunction +foreign import prim "any_ret_fun_arg_gen_big_framezh" any_ret_fun_arg_gen_big_frame# :: SetupFunction foreign import prim "any_bco_framezh" any_bco_frame# :: SetupFunction @@ -147,7 +146,6 @@ main = do e -> error $ "Wrong closure type: " ++ show e traceM $ "Test 10" testSize any_atomically_frame# 3 - -- TODO: Test for UnderflowFrame once it points to a Box payload traceM $ "Test 11" test any_ret_small_prim_frame# $ \case @@ -236,7 +234,7 @@ main = do traceM $ "Test 24" testSize any_ret_big_closures_two_words_frame# ((fromIntegral bitsInWord) + 1 + 1) traceM $ "Test 25" - test any_ret_fun_arg_n_prim_framezh# $ + test any_ret_fun_arg_n_prim_frame# $ \case RetFun {..} -> do assertEqual (tipe info) RET_FUN @@ -249,7 +247,7 @@ main = do assertEqual wds [1] e -> error $ "Wrong closure type: " ++ show e traceM $ "Test 26" - test any_ret_fun_arg_gen_framezh# $ + test any_ret_fun_arg_gen_frame# $ \case RetFun {..} -> do assertEqual (tipe info) RET_FUN @@ -268,10 +266,9 @@ main = do assertEqual wds [1 .. 9] e -> error $ "Wrong closure type: " ++ show e traceM $ "Test 27" - testSize any_ret_fun_arg_gen_framezh# (3 + 9) + testSize any_ret_fun_arg_gen_frame# (3 + 9) traceM $ "Test 28" - -- TODO: Check names: # and zh - test any_ret_fun_arg_gen_big_framezh# $ + test any_ret_fun_arg_gen_big_frame# $ \case RetFun {..} -> do assertEqual (tipe info) RET_FUN @@ -289,7 +286,7 @@ main = do let wds = map getWordFromConstr01 pCs assertEqual wds [1 .. 59] traceM $ "Test 29" - testSize any_ret_fun_arg_gen_big_framezh# (3 + 59) + testSize any_ret_fun_arg_gen_big_frame# (3 + 59) traceM $ "Test 30" test any_bco_frame# $ \case @@ -378,14 +375,6 @@ test setup assertion = do assert sn stack = do assertStackInvariants sn stack assertEqual (length stack) 2 - -- TODO: Isn't this also a stack invariant? (assertStackInvariants) - assertThat - "Last frame is stop frame" - ( \case - StopFrame info -> tipe info == STOP_FRAME - _ -> False - ) - (last stack) assertion $ head stack entertainGC :: Int -> String ===================================== rts/include/Stg.h ===================================== @@ -309,7 +309,7 @@ typedef StgFunPtr F_; #define EC_(X) extern StgWordArray (X) GNU_ATTRIBUTE(aligned (SIZEOF_VOID_P)) #define IC_(X) static StgWordArray (X) GNU_ATTRIBUTE(aligned (SIZEOF_VOID_P)) /* writable data (does not require alignment): */ -#define ERW_(X) extern StgWordArray (X) +#define ERW_(X) extern const StgWordArray (X) #define IRW_(X) static StgWordArray (X) /* read-only data (does not require alignment): */ #define ERO_(X) extern const StgWordArray (X) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/32e581a85cf92cde93ad1ca424f8f61eafbd3a96...a440f513988b32877d5cca9bcbd5a265e4d81256 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/32e581a85cf92cde93ad1ca424f8f61eafbd3a96...a440f513988b32877d5cca9bcbd5a265e4d81256 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Feb 12 08:51:12 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sun, 12 Feb 2023 03:51:12 -0500 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] Add case for CmmRetInfo to isSomeRODataLabel Message-ID: <63e8a880cfdae_50c5213e4a10c2129ab@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: 82033392 by Sven Tennie at 2023-02-12T08:50:33+00:00 Add case for CmmRetInfo to isSomeRODataLabel - - - - - 2 changed files: - compiler/GHC/Cmm/CLabel.hs - rts/include/Stg.h Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -794,6 +794,7 @@ isSomeRODataLabel (IdLabel _ _ LocalInfoTable) = True isSomeRODataLabel (IdLabel _ _ BlockInfoTable) = True -- info table defined in cmm (.cmm) isSomeRODataLabel (CmmLabel _ _ _ CmmInfo) = True +isSomeRODataLabel (CmmLabel _ _ _ CmmRetInfo) = True isSomeRODataLabel _lbl = False -- | Whether label is points to some kind of info table ===================================== rts/include/Stg.h ===================================== @@ -309,7 +309,7 @@ typedef StgFunPtr F_; #define EC_(X) extern StgWordArray (X) GNU_ATTRIBUTE(aligned (SIZEOF_VOID_P)) #define IC_(X) static StgWordArray (X) GNU_ATTRIBUTE(aligned (SIZEOF_VOID_P)) /* writable data (does not require alignment): */ -#define ERW_(X) extern const StgWordArray (X) +#define ERW_(X) extern StgWordArray (X) #define IRW_(X) static StgWordArray (X) /* read-only data (does not require alignment): */ #define ERO_(X) extern const StgWordArray (X) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/82033392304caa9c992071a240fca07864e10855 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/82033392304caa9c992071a240fca07864e10855 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Feb 12 09:40:28 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sun, 12 Feb 2023 04:40:28 -0500 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] 2 commits: Remove checkSTACK check Message-ID: <63e8b40cd9f97_50c521b2c4adc21529b@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: 45fe745d by Sven Tennie at 2023-02-12T09:39:29+00:00 Remove checkSTACK check - - - - - a4dfafd9 by Sven Tennie at 2023-02-12T09:40:02+00:00 Make valid casts - - - - - 2 changed files: - libraries/ghc-heap/cbits/Stack.cmm - libraries/ghc-heap/tests/stack_misc_closures_c.c Changes: ===================================== libraries/ghc-heap/cbits/Stack.cmm ===================================== @@ -178,7 +178,6 @@ getStackInfoTableAddrzh(P_ stack){ getBoxedClosurezh(P_ stack, W_ offsetWords){ ccall debugBelch("getBoxedClosurezh - stack %p , offsetWords %lu", stack, offsetWords); - ccall checkSTACK(stack); P_ ptr; ptr = StgStack_sp(stack) + WDS(offsetWords); ===================================== libraries/ghc-heap/tests/stack_misc_closures_c.c ===================================== @@ -29,7 +29,7 @@ void create_any_update_frame(Capability *cap, StgStack *stack, StgWord w) { StgUpdateFrame *updF = (StgUpdateFrame *)stack->sp; SET_HDR(updF, &stg_upd_frame_info, CCS_SYSTEM); // StgInd and a BLACKHOLE have the same structure - StgInd *blackhole = allocate(cap, sizeofW(StgInd)); + StgInd *blackhole = (StgInd *)allocate(cap, sizeofW(StgInd)); SET_HDR(blackhole, &test_fake_blackhole_info, CCS_SYSTEM); StgClosure *payload = rts_mkWord(cap, w); blackhole->indirectee = payload; @@ -207,8 +207,9 @@ RTS_RET(test_ret_bco); void create_any_bco_frame(Capability *cap, StgStack *stack, StgWord w) { StgClosure *c = (StgClosure *)stack->sp; SET_HDR(c, &test_ret_bco_info, CCS_SYSTEM); - StgWord bcoSizeWords = sizeofW(StgBCO) + sizeofW(StgLargeBitmap) + sizeofW(StgWord); - StgBCO *bco = allocate(cap, bcoSizeWords); + StgWord bcoSizeWords = + sizeofW(StgBCO) + sizeofW(StgLargeBitmap) + sizeofW(StgWord); + StgBCO *bco = (StgBCO *)allocate(cap, bcoSizeWords); SET_HDR(bco, &stg_BCO_info, CCS_MAIN); c->payload[0] = (StgClosure *)bco; @@ -231,7 +232,8 @@ void create_any_bco_frame(Capability *cap, StgStack *stack, StgWord w) { bco->literals = literals; StgWord ptrsSize = 1 + mutArrPtrsCardTableSize(1); - StgMutArrPtrs *ptrs = allocate(cap, sizeofW(StgMutArrPtrs) + ptrsSize); + StgMutArrPtrs *ptrs = + (StgMutArrPtrs *)allocate(cap, sizeofW(StgMutArrPtrs) + ptrsSize); SET_HDR(ptrs, &stg_MUT_ARR_PTRS_FROZEN_CLEAN_info, ccs); ptrs->ptrs = 1; ptrs->size = ptrsSize; @@ -366,8 +368,7 @@ StgStack *any_bco_frame(Capability *cap) { } StgStack *any_underflow_frame(Capability *cap) { - return setup(cap, sizeofW(StgUnderflowFrame), - &create_any_underflow_frame); + return setup(cap, sizeofW(StgUnderflowFrame), &create_any_underflow_frame); } void belchStack(StgStack *stack) { printStack(stack); } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/82033392304caa9c992071a240fca07864e10855...a4dfafd9b53365a4b4f7005fed86ce8c936a785b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/82033392304caa9c992071a240fca07864e10855...a4dfafd9b53365a4b4f7005fed86ce8c936a785b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Feb 12 11:48:12 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Sun, 12 Feb 2023 06:48:12 -0500 Subject: [Git][ghc/ghc][wip/T22948] 2 commits: Don't generate datacon wrappers for `type data` declarations Message-ID: <63e8d1fc89423_50c521b2c4adc22676a@gitlab.mail> Ryan Scott pushed to branch wip/T22948 at Glasgow Haskell Compiler / GHC Commits: f4da9f43 by Ryan Scott at 2023-02-12T06:47:39-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 688118fe by Ryan Scott at 2023-02-12T06:47:58-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - 11 changed files: - compiler/GHC/Core/Utils.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Types/Id/Make.hs - + testsuite/tests/pmcheck/should_compile/T22964.hs - testsuite/tests/pmcheck/should_compile/all.T - + testsuite/tests/type-data/should_compile/T22948b.hs - + testsuite/tests/type-data/should_compile/T22948b.stderr - testsuite/tests/type-data/should_compile/all.T - + testsuite/tests/type-data/should_run/T22948a.hs - testsuite/tests/type-data/should_run/all.T Changes: ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -728,9 +728,8 @@ refineDefaultAlt :: [Unique] -- ^ Uniques for constructing new binders refineDefaultAlt us mult tycon tys imposs_deflt_cons all_alts | Alt DEFAULT _ rhs : rest_alts <- all_alts , isAlgTyCon tycon -- It's a data type, tuple, or unboxed tuples. - , not (isNewTyCon tycon) -- We can have a newtype, if we are just doing an eval: - -- case x of { DEFAULT -> e } - -- and we don't want to fill in a default for them! + , not (isNewTyCon tycon) -- Exception 1 in Note [Refine DEFAULT case alternatives] + , not (isTypeDataTyCon tycon) -- Exception 2 in Note [Refine DEFAULT case alternatives] , Just all_cons <- tyConDataCons_maybe tycon , let imposs_data_cons = mkUniqSet [con | DataAlt con <- imposs_deflt_cons] -- We now know it's a data type, so we can use @@ -815,6 +814,39 @@ with a specific constructor is desirable. `imposs_deflt_cons` argument is populated with constructors which are matched elsewhere. +There are two exceptions where we avoid refining a DEFAULT case: + +* Exception 1: Newtypes + + We can have a newtype, if we are just doing an eval: + + case x of { DEFAULT -> e } + + And we don't want to fill in a default for them! + +* Exception 2: `type data` declarations + + The data constructors for a `type data` declaration (see + Note [Type data declarations] in GHC.Rename.Module) do not exist at the + value level. Nevertheless, it is possible to strictly evaluate a value + whose type is a `type data` declaration. Test case + type-data/should_compile/T2294b.hs contains an example: + + type data T a where + A :: T Int + + f :: T a -> () + f !x = () + + We want to generate the following Core for f: + + f = \(@a) (x :: T a) -> + case x of + __DEFAULT -> () + + Namely, we do _not_ want to match on `A`, as it doesn't exist at the value + level! + Note [Combine identical alternatives] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If several alternatives are identical, merge them into a single ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -146,11 +146,16 @@ updRcm f (RCM vanilla pragmas) -- Ex.: @vanillaCompleteMatchTC 'Maybe' ==> Just ("Maybe", {'Just','Nothing'})@ vanillaCompleteMatchTC :: TyCon -> Maybe CompleteMatch vanillaCompleteMatchTC tc = - let -- TYPE acts like an empty data type on the term-level (#14086), but - -- it is a PrimTyCon, so tyConDataCons_maybe returns Nothing. Hence a - -- special case. - mb_dcs | tc == tYPETyCon = Just [] - | otherwise = tyConDataCons_maybe tc + let mb_dcs | -- TYPE acts like an empty data type on the term level (#14086), + -- but it is a PrimTyCon, so tyConDataCons_maybe returns Nothing. + -- Hence a special case. + tc == tYPETyCon = Just [] + | -- Similarly, treat `type data` declarations as empty data types on + -- the term level, as `type data` data constructors only exist at + -- the type level (#22964). + -- See Note [Type data declarations] in GHC.Rename.Module. + isTypeDataTyCon tc = Just [] + | otherwise = tyConDataCons_maybe tc in vanillaCompleteMatch . mkUniqDSet . map RealDataCon <$> mb_dcs -- | Initialise from 'dsGetCompleteMatches' (containing all COMPLETE pragmas) ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -2132,6 +2132,35 @@ The main parts of the implementation are: `type data` declarations. When these are converted back to Hs types in a splice, the constructors are placed in the TcCls namespace. +* A `type data` declaration _never_ generates wrappers for its data + constructors, as they only make sense for value-level data constructors. + This extends to `type data` declarations implemented as GADTs, such as + this example from #22948: + + type data T a where + A :: T Int + B :: T a + + If `T` were an ordinary `data` declaration, then `A` would have a wrapper + to account for the GADT-like equality in its return type. Because `T` is + declared as a `type data` declaration, however, the wrapper is omitted. + See `wrapped_reqd` in GHC.Types.Id.Make.mkDataConRep` for the place where + this check is implemented. + +* Although `type data` data constructors do not exist at the value level, + it is still possible to match on a value whose type is headed by a `type data` + type constructor, such as this example from #22964: + + type data T a where + A :: T Int + B :: T a + + f :: T a -> () + f x = case x of {} + + During checking the coverage of `f`'s pattern matches, we treat `T` as if it + were an empty data type so that GHC does not warn the user to match against + `A` or `B`. -} warnNoDerivStrat :: Maybe (LDerivStrategy GhcRn) ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -789,6 +789,10 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con (unboxers, boxers) = unzip wrappers (rep_tys, rep_strs) = unzip (concat rep_tys_w_strs) + -- This is True if the data constructor or class dictionary constructor + -- needs a wrapper. This wrapper is injected into the program later in the + -- CoreTidy pass. See Note [Injecting implicit bindings] in GHC.Iface.Tidy, + -- along with the accompanying implementation in getTyConImplicitBinds. wrapper_reqd = (not new_tycon -- (Most) newtypes have only a worker, with the exception @@ -796,13 +800,27 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con && (any isBanged (ev_ibangs ++ arg_ibangs))) -- Some forcing/unboxing (includes eq_spec) || isFamInstTyCon tycon -- Cast result - || dataConUserTyVarsNeedWrapper data_con + || (dataConUserTyVarsNeedWrapper data_con -- If the data type was written with GADT syntax and -- orders the type variables differently from what the -- worker expects, it needs a data con wrapper to reorder -- the type variables. - -- See Note [Data con wrappers and GADT syntax]. - -- NB: All GADTs return true from this function + -- + -- NB: All GADTs return true from this function, but there + -- is one exception that we must check below. + && not (isTypeDataTyCon tycon)) + -- An exception to this rule is `type data` declarations. + -- Their data constructors only live at the type level and + -- therefore do not need wrappers. + -- See Note [Type data declarations] in GHC.Rename.Module. + -- + -- Note that the other checks in this definition will + -- return False for `type data` declarations, as: + -- + -- - They cannot be newtypes + -- - They cannot have strict fields + -- - They cannot be data family instances + -- - They cannot have datatype contexts || not (null stupid_theta) -- If the data constructor has a datatype context, -- we need a wrapper in order to drop the stupid arguments. ===================================== testsuite/tests/pmcheck/should_compile/T22964.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE TypeData #-} +module X where + +type data T1 a where + A1 :: T1 Int + B1 :: T1 a + +f1 :: T1 a -> () +f1 x = case x of {} + +type data T2 a where + A2 :: T2 Int + +f2 :: T2 a -> () +f2 x = case x of {} ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -158,3 +158,4 @@ test('EmptyCase009', [], compile, [overlapping_incomplete]) test('EmptyCase010', [], compile, [overlapping_incomplete]) test('T19271', [], compile, [overlapping_incomplete]) test('T21761', [], compile, [overlapping_incomplete]) +test('T22964', [], compile, [overlapping_incomplete]) ===================================== testsuite/tests/type-data/should_compile/T22948b.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeData #-} +module T22948b where + +type data T a where + A :: T Int + +f :: T a -> () +f !x = () ===================================== testsuite/tests/type-data/should_compile/T22948b.stderr ===================================== @@ -0,0 +1,4 @@ + +T22948b.hs:8:1: warning: [GHC-94210] [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘f’: f !x = ... ===================================== testsuite/tests/type-data/should_compile/all.T ===================================== @@ -5,3 +5,4 @@ test('TDGoodConsConstraints', normal, compile, ['']) test('TDVector', normal, compile, ['']) test('TD_TH_splice', js_broken(22576), compile, ['']) test('T22315a', [extra_files(['T22315a/'])], multimod_compile, ['T22315a.Lib T22315a.Main', '-v0']) +test('T22948b', normal, compile, ['']) ===================================== testsuite/tests/type-data/should_run/T22948a.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeData #-} +module Main where + +type data T a where + A :: T Int + B :: T a + +main = return () ===================================== testsuite/tests/type-data/should_run/all.T ===================================== @@ -1,3 +1,4 @@ test('T22332a', exit_code(1), compile_and_run, ['']) test('T22315b', extra_files(['T22315b.hs']), ghci_script, ['T22315b.script']) test('T22500', normal, compile_and_run, ['']) +test('T22948a', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/78dc538f31dd54f47f956e1ca66b75ce8251dc1c...688118fee8345f046ccffdc3a1822903b2fa34ce -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/78dc538f31dd54f47f956e1ca66b75ce8251dc1c...688118fee8345f046ccffdc3a1822903b2fa34ce You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Feb 12 13:44:01 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Sun, 12 Feb 2023 08:44:01 -0500 Subject: [Git][ghc/ghc][wip/T22948] Disallow `tagToEnum#` on type data types Message-ID: <63e8ed2175921_50c522304653c244730@gitlab.mail> Ryan Scott pushed to branch wip/T22948 at Glasgow Haskell Compiler / GHC Commits: 24bbdc3c by Ryan Scott at 2023-02-12T08:42:25-05:00 Disallow `tagToEnum#` on type data types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8 changed files: - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Types/Error/Codes.hs - + testsuite/tests/type-data/should_fail/TDTagToEnum.hs - + testsuite/tests/type-data/should_fail/TDTagToEnum.stderr - testsuite/tests/type-data/should_fail/all.T Changes: ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -2161,6 +2161,15 @@ The main parts of the implementation are: During checking the coverage of `f`'s pattern matches, we treat `T` as if it were an empty data type so that GHC does not warn the user to match against `A` or `B`. + +* To prevent users from conjuring up `type data` values at the term level, we + disallow using the tagToEnum# function on a type headed by a `type data` + type. For instance, GHC will reject this code: + + type data Letter = A | B | C + + f :: Letter + f = tagToEnum# 0# -} warnNoDerivStrat :: Maybe (LDerivStrategy GhcRn) ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -276,6 +276,10 @@ instance Diagnostic TcRnMessage where -> mkSimpleDecorated $ hang (text "Bad call to tagToEnum# at type" <+> ppr ty) 2 (text "Result type must be an enumeration type") + TcRnTagToEnumResTyTypeData ty + -> mkSimpleDecorated $ + hang (text "Bad call to tagToEnum# at type" <+> ppr ty) + 2 (text "Result type cannot be headed by a `type data` type") TcRnArrowIfThenElsePredDependsOnResultTy -> mkSimpleDecorated $ text "Predicate type of `ifThenElse' depends on result type" @@ -1379,6 +1383,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnTagToEnumResTyNotAnEnum{} -> ErrorWithoutFlag + TcRnTagToEnumResTyTypeData{} + -> ErrorWithoutFlag TcRnArrowIfThenElsePredDependsOnResultTy -> ErrorWithoutFlag TcRnIllegalHsBootFileDecl @@ -1807,6 +1813,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnTagToEnumResTyNotAnEnum{} -> noHints + TcRnTagToEnumResTyTypeData{} + -> noHints TcRnArrowIfThenElsePredDependsOnResultTy -> noHints TcRnIllegalHsBootFileDecl ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -665,6 +665,20 @@ data TcRnMessage where -} TcRnTagToEnumResTyNotAnEnum :: Type -> TcRnMessage + {-| TcRnTagToEnumResTyTypeData is an error that occurs when the 'tagToEnum#' + function is given a result type that is headed by a @type data@ type, as + the data constructors of a @type data@ do not exist at the term level. + + Example(s): + type data Letter = A | B | C + + foo :: Letter + foo = tagToEnum# 0# + + Test cases: type-data/should_fail/TDTagToEnum.hs + -} + TcRnTagToEnumResTyTypeData :: Type -> TcRnMessage + {-| TcRnArrowIfThenElsePredDependsOnResultTy is an error that occurs when the predicate type of an ifThenElse expression in arrow notation depends on the type of the result. ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -1226,6 +1226,7 @@ tcTagToEnum tc_fun fun_ctxt tc_args res_ty vanilla_result = rebuildHsApps tc_fun fun_ctxt tc_args res_ty check_enumeration ty' tc + | isTypeDataTyCon tc = addErrTc (TcRnTagToEnumResTyTypeData ty') | isEnumerationTyCon tc = return () | otherwise = addErrTc (TcRnTagToEnumResTyNotAnEnum ty') ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -354,6 +354,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnTagToEnumMissingValArg" = 36495 GhcDiagnosticCode "TcRnTagToEnumUnspecifiedResTy" = 08522 GhcDiagnosticCode "TcRnTagToEnumResTyNotAnEnum" = 49356 + GhcDiagnosticCode "TcRnTagToEnumResTyTypeData" = 96189 GhcDiagnosticCode "TcRnArrowIfThenElsePredDependsOnResultTy" = 55868 GhcDiagnosticCode "TcRnIllegalHsBootFileDecl" = 58195 GhcDiagnosticCode "TcRnRecursivePatternSynonym" = 72489 ===================================== testsuite/tests/type-data/should_fail/TDTagToEnum.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TypeData #-} +module TDTagToEnum where + +import GHC.Exts (tagToEnum#) + +type data Letter = A | B | C + +f :: Letter +f = tagToEnum# 0# ===================================== testsuite/tests/type-data/should_fail/TDTagToEnum.stderr ===================================== @@ -0,0 +1,6 @@ + +TDTagToEnum.hs:10:5: error: [GHC-96189] + • Bad call to tagToEnum# at type Letter + Result type cannot be headed by a `type data` type + • In the expression: tagToEnum# 0# + In an equation for ‘f’: f = tagToEnum# 0# ===================================== testsuite/tests/type-data/should_fail/all.T ===================================== @@ -11,4 +11,5 @@ test('TDRecordsH98', normal, compile_fail, ['']) test('TDRecursive', normal, compile_fail, ['']) test('TDStrictnessGADT', normal, compile_fail, ['']) test('TDStrictnessH98', normal, compile_fail, ['']) +test('TDTagToEnum', normal, compile_fail, ['']) test('T22332b', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/24bbdc3c861a495b5f4aba105227c480d14ca9b2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/24bbdc3c861a495b5f4aba105227c480d14ca9b2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Feb 12 16:37:19 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Sun, 12 Feb 2023 11:37:19 -0500 Subject: [Git][ghc/ghc][wip/js-rts-fixmes] 14 commits: JS generated refs: update testsuite conditions Message-ID: <63e915bfd8852_50c5213e4a10c251217@gitlab.mail> Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC Commits: d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - ad9913f5 by Josh Meredith at 2023-02-12T16:36:30+00:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} - - - - - c66f45eb by Josh Meredith at 2023-02-12T16:36:30+00:00 Cache names used commonly in JS backend RTS generation - - - - - 49117183 by Sylvain Henry at 2023-02-12T16:36:30+00:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 079132b0 by Josh Meredith at 2023-02-12T16:36:30+00:00 JS/Make: reduce cache sizes - - - - - c0791ba3 by Josh Meredith at 2023-02-12T16:36:52+00:00 JS RTS: use jsClosureCount for closureConstructors and cache sizes - - - - - 29 changed files: - .gitlab/merge_request_templates/merge-request.md - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/JS/Make.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Unit/Module/ModIface.hs - libraries/base/Data/OldList.hs - libraries/base/tests/all.T - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - libraries/template-haskell/changelog.md - libraries/transformers - testsuite/driver/testlib.py - testsuite/tests/driver/T1959/test.T - testsuite/tests/ffi/should_run/all.T - testsuite/tests/rts/all.T - testsuite/tests/safeHaskell/check/pkg01/all.T - + testsuite/tests/simplCore/should_compile/T22761.hs - + testsuite/tests/simplCore/should_compile/T22761a.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== .gitlab/merge_request_templates/merge-request.md ===================================== @@ -5,18 +5,19 @@ expectations. Also please answer the following question in your MR description:* **Where is the key part of this patch? That is, what should reviewers look at first?** -Please take a few moments to verify that your commits fulfill the following: +Please take a few moments to address the following points: - * [ ] are either individually buildable or squashed - * [ ] have commit messages which describe *what they do* - (referring to [Notes][notes] and tickets using `#NNNN` syntax when - appropriate) + * [ ] if your MR may break existing programs (e.g. touches `base` or causes the + compiler to reject programs), please describe the expected breakage and add + the ~"user facing" label. This will run ghc/head.hackage> to characterise + the effect of your change on Hackage. + * [ ] ensure that your commits are either individually buildable or squashed + * [ ] ensure that your commit messages describe *what they do* + (referring to tickets using `#NNNN` syntax when appropriate) * [ ] have added source comments describing your change. For larger changes you likely should add a [Note][notes] and cross-reference it from the relevant places. - * [ ] add a [testcase to the testsuite](https://gitlab.haskell.org/ghc/ghc/wikis/building/running-tests/adding). - * [ ] if your MR affects library interfaces (e.g. changes `base`) or affects whether GHC will accept user-written code, please add - the ~"user facing" label. + * [ ] add a [testcase to the testsuite][adding test]. * [ ] updates the users guide if applicable * [ ] mentions new features in the release notes for the next release @@ -29,3 +30,4 @@ no one has offerred review in a few days then please leave a comment mentioning @triagers. [notes]: https://gitlab.haskell.org/ghc/ghc/wikis/commentary/coding-style#comments-in-the-source-code +[adding test]: https://gitlab.haskell.org/ghc/ghc/wikis/building/running-tests/adding ===================================== compiler/GHC/Core.hs ===================================== @@ -1300,16 +1300,19 @@ data Unfolding df_args :: [CoreExpr] -- Args of the data con: types, superclasses and methods, } -- in positional order - | CoreUnfolding { -- An unfolding for an Id with no pragma, - -- or perhaps a NOINLINE pragma - -- (For NOINLINE, the phase, if any, is in the - -- InlinePragInfo for this Id.) - uf_tmpl :: CoreExpr, -- Template; occurrence info is correct - uf_src :: UnfoldingSource, -- Where the unfolding came from - uf_is_top :: Bool, -- True <=> top level binding - uf_cache :: UnfoldingCache, -- Cache of flags computable from the expr - -- See Note [Tying the 'CoreUnfolding' knot] - uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template. + | CoreUnfolding { -- An unfolding for an Id with no pragma, + -- or perhaps a NOINLINE pragma + -- (For NOINLINE, the phase, if any, is in the + -- InlinePragInfo for this Id.) + uf_tmpl :: CoreExpr, -- The unfolding itself (aka "template") + -- Always occ-analysed; + -- See Note [OccInfo in unfoldings and rules] + + uf_src :: UnfoldingSource, -- Where the unfolding came from + uf_is_top :: Bool, -- True <=> top level binding + uf_cache :: UnfoldingCache, -- Cache of flags computable from the expr + -- See Note [Tying the 'CoreUnfolding' knot] + uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template. } -- ^ An unfolding with redundant cached information. Parameters: -- @@ -1637,14 +1640,37 @@ change was requested by Roman, but it seems to make sense. Note [OccInfo in unfoldings and rules] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In unfoldings and rules, we guarantee that the template is occ-analysed, -so that the occurrence info on the binders is correct. This is important, -because the Simplifier does not re-analyse the template when using it. If -the occurrence info is wrong - - We may get more simplifier iterations than necessary, because - once-occ info isn't there - - More seriously, we may get an infinite loop if there's a Rec - without a loop breaker marked +In unfoldings and rules, we guarantee that the template is occ-analysed, so +that the occurrence info on the binders is correct. That way, when the +Simplifier inlines an unfolding, it doesn't need to occ-analysis it first. +(The Simplifier is designed to simplify occ-analysed expressions.) + +Given this decision it's vital that we do *always* do it. + +* If we don't, we may get more simplifier iterations than necessary, + because once-occ info isn't there + +* More seriously, we may get an infinite loop if there's a Rec without a + loop breaker marked. + +* Or we may get code that mentions variables not in scope: #22761 + e.g. Suppose we have a stable unfolding : \y. let z = p+1 in 3 + Then the pre-simplifier occ-anal will occ-anal the unfolding + (redundantly perhaps, but we need its free vars); this will not report + the use of `p`; so p's binding will be discarded, and yet `p` is still + mentioned. + + Better to occ-anal the unfolding at birth, which will drop the + z-binding as dead code. (Remember, it's the occurrence analyser that + drops dead code.) + +* Another example is #8892: + \x -> letrec { f = ...g...; g* = f } in body + where g* is (for some strange reason) the loop breaker. If we don't + occ-anal it when reading it in, we won't mark g as a loop breaker, and we + may inline g entirely in body, dropping its binding, and leaving the + occurrence in f out of scope. This happened in #8892, where the unfolding + in question was a DFun unfolding. ************************************************************************ ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -3088,8 +3088,15 @@ etaExpandToJoinPointRule join_arity rule@(Rule { ru_bndrs = bndrs, ru_rhs = rhs | need_args < 0 = pprPanic "etaExpandToJoinPointRule" (ppr join_arity $$ ppr rule) | otherwise - = rule { ru_bndrs = bndrs ++ new_bndrs, ru_args = args ++ new_args - , ru_rhs = new_rhs } + = rule { ru_bndrs = bndrs ++ new_bndrs + , ru_args = args ++ new_args + , ru_rhs = new_rhs } + -- new_rhs really ought to be occ-analysed (see GHC.Core Note + -- [OccInfo in unfoldings and rules]), but it makes a module loop to + -- do so; it doesn't happen often; and it doesn't really matter if + -- the outer binders have bogus occurrence info; and new_rhs won't + -- have dead code if rhs didn't. + where need_args = join_arity - length args (new_bndrs, new_rhs) = etaBodyForJoinPoint need_args rhs ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -2165,6 +2165,17 @@ So we have a fast-path that keeps the old tree if the occ_bs_env is empty. This just saves a bit of allocation and reconstruction; not a big deal. +This fast path exposes a tricky cornder, though (#22761). Supose we have + Unfolding = \x. let y = foo in x+1 +which includes a dead binding for `y`. In occAnalUnfolding we occ-anal +the unfolding and produce /no/ occurrences of `foo` (since `y` is +dead). But if we discard the occ-analysed syntax tree (which we do on +our fast path), and use the old one, we still /have/ an occurrence of +`foo` -- and that can lead to out-of-scope variables (#22761). + +Solution: always keep occ-analysed trees in unfoldings and rules, so they +have no dead code. See Note [OccInfo in unfoldings and rules] in GHC.Core. + Note [Cascading inlines] ~~~~~~~~~~~~~~~~~~~~~~~~ By default we use an rhsCtxt for the RHS of a binding. This tells the ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -1065,7 +1065,7 @@ subst_id_bndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) -- See Note [Bangs in the Simplifier] !id1 = uniqAway in_scope old_id !id2 = substIdType env id1 - !id3 = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding + !id3 = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding -- and fragile OccInfo !new_id = adjust_type id3 ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -319,14 +319,14 @@ simplLazyBind :: SimplEnv -> TopLevelFlag -> RecFlag -> InId -> OutId -- Binder, both pre-and post simpl -- Not a JoinId - -- The OutId has IdInfo, except arity, unfolding + -- The OutId has IdInfo (notably RULES), + -- except arity, unfolding -- Ids only, no TyVars -> InExpr -> SimplEnv -- The RHS and its environment -> SimplM (SimplFloats, SimplEnv) -- Precondition: the OutId is already in the InScopeSet of the incoming 'env' -- Precondition: not a JoinId -- Precondition: rhs obeys the let-can-float invariant --- NOT used for JoinIds simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se = assert (isId bndr ) assertPpr (not (isJoinId bndr)) (ppr bndr) $ @@ -398,48 +398,45 @@ simplJoinBind env is_rec cont old_bndr new_bndr rhs rhs_se ; completeBind env (BC_Join is_rec cont) old_bndr new_bndr rhs' } -------------------------- -simplNonRecX :: SimplEnv +simplAuxBind :: SimplEnv -> InId -- Old binder; not a JoinId -> OutExpr -- Simplified RHS -> SimplM (SimplFloats, SimplEnv) --- A specialised variant of simplNonRec used when the RHS is already --- simplified, notably in knownCon. It uses case-binding where necessary. +-- A specialised variant of completeBindX used to construct non-recursive +-- auxiliary bindings, notably in knownCon. +-- +-- The binder comes from a case expression (case binder or alternative) +-- and so does not have rules, inline pragmas etc. -- -- Precondition: rhs satisfies the let-can-float invariant -simplNonRecX env bndr new_rhs - | assertPpr (not (isJoinId bndr)) (ppr bndr) $ +simplAuxBind env bndr new_rhs + | assertPpr (isId bndr && not (isJoinId bndr)) (ppr bndr) $ isDeadBinder bndr -- Not uncommon; e.g. case (a,b) of c { (p,q) -> p } = return (emptyFloats env, env) -- Here c is dead, and we avoid - -- creating the binding c = (a,b) - - | Coercion co <- new_rhs - = return (emptyFloats env, extendCvSubst env bndr co) + -- creating the binding c = (a,b) + -- The cases would be inlined unconditionally by completeBind: + -- but it seems not uncommon, and avoids faff to do it here + -- This is safe because it's only used for auxiliary bindings, which + -- have no NOLINE pragmas, nor RULEs | exprIsTrivial new_rhs -- Short-cut for let x = y in ... - -- This case would ultimately land in postInlineUnconditionally - -- but it seems not uncommon, and avoids a lot of faff to do it here - = return (emptyFloats env - , extendIdSubst env bndr (DoneEx new_rhs Nothing)) + = return ( emptyFloats env + , case new_rhs of + Coercion co -> extendCvSubst env bndr co + _ -> extendIdSubst env bndr (DoneEx new_rhs Nothing) ) | otherwise - = do { (env1, new_bndr) <- simplBinder env bndr - ; let is_strict = isStrictId new_bndr - -- isStrictId: use new_bndr because the InId bndr might not have - -- a fixed runtime representation, which isStrictId doesn't expect - -- c.f. Note [Dark corner with representation polymorphism] - - ; (rhs_floats, rhs1) <- prepareBinding env NotTopLevel NonRecursive is_strict - new_bndr (emptyFloats env) new_rhs - -- NB: it makes a surprisingly big difference (5% in compiler allocation - -- in T9630) to pass 'env' rather than 'env1'. It's fine to pass 'env', - -- because this is simplNonRecX, so bndr is not in scope in the RHS. - - ; (bind_float, env2) <- completeBind (env1 `setInScopeFromF` rhs_floats) - (BC_Let NotTopLevel NonRecursive) + = do { -- ANF-ise the RHS + let !occ_fs = getOccFS bndr + ; (anf_floats, rhs1) <- prepareRhs env NotTopLevel occ_fs new_rhs + ; unless (isEmptyLetFloats anf_floats) (tick LetFloatFromLet) + ; let rhs_floats = emptyFloats env `addLetFloats` anf_floats + + -- Simplify the binder and complete the binding + ; (env1, new_bndr) <- simplBinder (env `setInScopeFromF` rhs_floats) bndr + ; (bind_float, env2) <- completeBind env1 (BC_Let NotTopLevel NonRecursive) bndr new_bndr rhs1 - -- Must pass env1 to completeBind in case simplBinder had to clone, - -- and extended the substitution with [bndr :-> new_bndr] ; return (rhs_floats `addFloats` bind_float, env2) } @@ -761,49 +758,54 @@ prepareRhs :: HasDebugCallStack -- x = Just a -- See Note [prepareRhs] prepareRhs env top_lvl occ rhs0 - = do { (_is_exp, floats, rhs1) <- go 0 rhs0 - ; return (floats, rhs1) } + | is_expandable = anfise rhs0 + | otherwise = return (emptyLetFloats, rhs0) where - go :: Int -> OutExpr -> SimplM (Bool, LetFloats, OutExpr) - go n_val_args (Cast rhs co) - = do { (is_exp, floats, rhs') <- go n_val_args rhs - ; return (is_exp, floats, Cast rhs' co) } - go n_val_args (App fun (Type ty)) - = do { (is_exp, floats, rhs') <- go n_val_args fun - ; return (is_exp, floats, App rhs' (Type ty)) } - go n_val_args (App fun arg) - = do { (is_exp, floats1, fun') <- go (n_val_args+1) fun - ; if is_exp - then do { (floats2, arg') <- makeTrivial env top_lvl topDmd occ arg - ; return (True, floats1 `addLetFlts` floats2, App fun' arg') } - else return (False, emptyLetFloats, App fun arg) - } - go n_val_args (Var fun) - = return (is_exp, emptyLetFloats, Var fun) - where - is_exp = isExpandableApp fun n_val_args -- The fun a constructor or PAP - -- See Note [CONLIKE pragma] in GHC.Types.Basic - -- The definition of is_exp should match that in - -- 'GHC.Core.Opt.OccurAnal.occAnalApp' - - go n_val_args (Tick t rhs) + -- We can' use exprIsExpandable because the WHOLE POINT is that + -- we want to treat (K ) as expandable, because we are just + -- about "anfise" the expression. exprIsExpandable would + -- just say no! + is_expandable = go rhs0 0 + where + go (Var fun) n_val_args = isExpandableApp fun n_val_args + go (App fun arg) n_val_args + | isTypeArg arg = go fun n_val_args + | otherwise = go fun (n_val_args + 1) + go (Cast rhs _) n_val_args = go rhs n_val_args + go (Tick _ rhs) n_val_args = go rhs n_val_args + go _ _ = False + + anfise :: OutExpr -> SimplM (LetFloats, OutExpr) + anfise (Cast rhs co) + = do { (floats, rhs') <- anfise rhs + ; return (floats, Cast rhs' co) } + anfise (App fun (Type ty)) + = do { (floats, rhs') <- anfise fun + ; return (floats, App rhs' (Type ty)) } + anfise (App fun arg) + = do { (floats1, fun') <- anfise fun + ; (floats2, arg') <- makeTrivial env top_lvl topDmd occ arg + ; return (floats1 `addLetFlts` floats2, App fun' arg') } + anfise (Var fun) + = return (emptyLetFloats, Var fun) + + anfise (Tick t rhs) -- We want to be able to float bindings past this -- tick. Non-scoping ticks don't care. | tickishScoped t == NoScope - = do { (is_exp, floats, rhs') <- go n_val_args rhs - ; return (is_exp, floats, Tick t rhs') } + = do { (floats, rhs') <- anfise rhs + ; return (floats, Tick t rhs') } -- On the other hand, for scoping ticks we need to be able to -- copy them on the floats, which in turn is only allowed if -- we can obtain non-counting ticks. | (not (tickishCounts t) || tickishCanSplit t) - = do { (is_exp, floats, rhs') <- go n_val_args rhs + = do { (floats, rhs') <- anfise rhs ; let tickIt (id, expr) = (id, mkTick (mkNoCount t) expr) floats' = mapLetFloats floats tickIt - ; return (is_exp, floats', Tick t rhs') } + ; return (floats', Tick t rhs') } - go _ other - = return (False, emptyLetFloats, other) + anfise other = return (emptyLetFloats, other) makeTrivialArg :: HasDebugCallStack => SimplEnv -> ArgSpec -> SimplM (LetFloats, ArgSpec) makeTrivialArg env arg@(ValArg { as_arg = e, as_dmd = dmd }) @@ -1244,7 +1246,7 @@ simplExprF1 env (Let (NonRec bndr rhs) body) cont | otherwise = {-#SCC "simplNonRecE" #-} - simplNonRecE env False bndr (rhs, env) body cont + simplNonRecE env FromLet bndr (rhs, env) body cont {- Note [Avoiding space leaks in OutType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1505,8 +1507,9 @@ rebuild env expr cont StrictArg { sc_fun = fun, sc_cont = cont, sc_fun_ty = fun_ty } -> rebuildCall env (addValArgTo fun expr fun_ty ) cont - StrictBind { sc_bndr = b, sc_body = body, sc_env = se, sc_cont = cont } - -> completeBindX (se `setInScopeFromE` env) b expr body cont + StrictBind { sc_bndr = b, sc_body = body, sc_env = se + , sc_cont = cont, sc_from = from_what } + -> completeBindX (se `setInScopeFromE` env) from_what b expr body cont ApplyToTy { sc_arg_ty = ty, sc_cont = cont} -> rebuild env (App expr (Type ty)) cont @@ -1518,25 +1521,48 @@ rebuild env expr cont ; rebuild env (App expr arg') cont } completeBindX :: SimplEnv + -> FromWhat -> InId -> OutExpr -- Bind this Id to this (simplified) expression -- (the let-can-float invariant may not be satisfied) - -> InExpr -- In this lambda + -> InExpr -- In this body -> SimplCont -- Consumed by this continuation -> SimplM (SimplFloats, OutExpr) -completeBindX env bndr rhs body cont - | needsCaseBinding (idType bndr) rhs -- Enforcing the let-can-float-invariant - = do { (env1, bndr1) <- simplNonRecBndr env bndr - ; (floats, expr') <- simplLam env1 body cont +completeBindX env from_what bndr rhs body cont + | FromBeta arg_ty <- from_what + , needsCaseBinding arg_ty rhs -- Enforcing the let-can-float-invariant + = do { (env1, bndr1) <- simplNonRecBndr env bndr -- Lambda binders don't have rules + ; (floats, expr') <- simplNonRecBody env1 from_what body cont -- Do not float floats past the Case binder below ; let expr'' = wrapFloats floats expr' - ; let case_expr = Case rhs bndr1 (contResultType cont) [Alt DEFAULT [] expr''] + case_expr = Case rhs bndr1 (contResultType cont) [Alt DEFAULT [] expr''] ; return (emptyFloats env, case_expr) } - | otherwise - = do { (floats1, env') <- simplNonRecX env bndr rhs - ; (floats2, expr') <- simplLam env' body cont - ; return (floats1 `addFloats` floats2, expr') } + | otherwise -- Make a let-binding + = do { (env1, bndr1) <- simplNonRecBndr env bndr + ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) + + ; let is_strict = isStrictId bndr2 + -- isStrictId: use simplified binder because the InId bndr might not have + -- a fixed runtime representation, which isStrictId doesn't expect + -- c.f. Note [Dark corner with representation polymorphism] + + ; (rhs_floats, rhs1) <- prepareBinding env NotTopLevel NonRecursive is_strict + bndr2 (emptyFloats env) rhs + -- NB: it makes a surprisingly big difference (5% in compiler allocation + -- in T9630) to pass 'env' rather than 'env1'. It's fine to pass 'env', + -- because this is simplNonRecX, so bndr is not in scope in the RHS. + + ; (bind_float, env2) <- completeBind (env2 `setInScopeFromF` rhs_floats) + (BC_Let NotTopLevel NonRecursive) + bndr bndr2 rhs1 + -- Must pass env1 to completeBind in case simplBinder had to clone, + -- and extended the substitution with [bndr :-> new_bndr] + + -- Simplify the body + ; (body_floats, body') <- simplNonRecBody env2 from_what body cont + ; let all_floats = rhs_floats `addFloats` bind_float `addFloats` body_floats + ; return ( all_floats, body' ) } {- ************************************************************************ @@ -1674,6 +1700,14 @@ simplArg env dup_flag fun_ty arg_env arg ************************************************************************ -} +simplNonRecBody :: SimplEnv -> FromWhat + -> InExpr -> SimplCont + -> SimplM (SimplFloats, OutExpr) +simplNonRecBody env from_what body cont + = case from_what of + FromLet -> simplExprF env body cont + FromBeta {} -> simplLam env body cont + simplLam :: SimplEnv -> InExpr -> SimplCont -> SimplM (SimplFloats, OutExpr) @@ -1690,15 +1724,24 @@ simpl_lam env bndr body (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = cont }) -- Value beta-reduction simpl_lam env bndr body (ApplyToVal { sc_arg = arg, sc_env = arg_se - , sc_cont = cont, sc_dup = dup }) - | isSimplified dup -- Don't re-simplify if we've simplified it once - -- See Note [Avoiding exponential behaviour] + , sc_cont = cont, sc_dup = dup + , sc_hole_ty = fun_ty}) = do { tick (BetaReduction bndr) - ; completeBindX env bndr arg body cont } + ; let arg_ty = funArgTy fun_ty + ; if | isSimplified dup -- Don't re-simplify if we've simplified it once + -- Including don't preInlineUnconditionally + -- See Note [Avoiding exponential behaviour] + -> completeBindX env (FromBeta arg_ty) bndr arg body cont + + | Just env' <- preInlineUnconditionally env NotTopLevel bndr arg arg_se + , not (needsCaseBinding arg_ty arg) + -- Ok to test arg::InExpr in needsCaseBinding because + -- exprOkForSpeculation is stable under simplification + -> do { tick (PreInlineUnconditionally bndr) + ; simplLam env' body cont } - | otherwise -- See Note [Avoiding exponential behaviour] - = do { tick (BetaReduction bndr) - ; simplNonRecE env True bndr (arg, arg_se) body cont } + | otherwise + -> simplNonRecE env (FromBeta arg_ty) bndr (arg, arg_se) body cont } -- Discard a non-counting tick on a lambda. This may change the -- cost attribution slightly (moving the allocation of the @@ -1730,8 +1773,7 @@ simplLamBndrs env bndrs = mapAccumLM simplLamBndr env bndrs ------------------ simplNonRecE :: SimplEnv - -> Bool -- True <=> from a lambda - -- False <=> from a let + -> FromWhat -> InId -- The binder, always an Id -- Never a join point -> (InExpr, SimplEnv) -- Rhs of binding (or arg of lambda) @@ -1740,56 +1782,48 @@ simplNonRecE :: SimplEnv -> SimplM (SimplFloats, OutExpr) -- simplNonRecE is used for --- * non-top-level non-recursive non-join-point lets in expressions --- * beta reduction +-- * from=FromLet: a non-top-level non-recursive non-join-point let-expression +-- * from=FromBeta: a binding arising from a beta reduction -- --- simplNonRec env b (rhs, rhs_se) body k +-- simplNonRecE env b (rhs, rhs_se) body k -- = let env in -- cont< let b = rhs_se(rhs) in body > -- -- It deals with strict bindings, via the StrictBind continuation, -- which may abort the whole process. -- --- from_lam=False => the RHS satisfies the let-can-float invariant +-- from_what=FromLet => the RHS satisfies the let-can-float invariant -- Otherwise it may or may not satisfy it. -simplNonRecE env from_lam bndr (rhs, rhs_se) body cont - = assert (isId bndr && not (isJoinId bndr) ) $ - do { (env1, bndr1) <- simplNonRecBndr env bndr - ; let needs_case_binding = needsCaseBinding (idType bndr1) rhs - -- See Note [Dark corner with representation polymorphism] - -- If from_lam=False then needs_case_binding is False, - -- because the binding started as a let, which must - -- satisfy let-can-float - - ; if | from_lam && not needs_case_binding - -- If not from_lam we are coming from a (NonRec bndr rhs) binding - -- and preInlineUnconditionally has been done already; - -- no need to repeat it. But for lambdas we must be careful about - -- preInlineUndonditionally: consider (\(x:Int#). 3) (error "urk") - -- We must not drop the (error "urk"). - , Just env' <- preInlineUnconditionally env NotTopLevel bndr rhs rhs_se - -> do { tick (PreInlineUnconditionally bndr) - ; -- pprTrace "preInlineUncond" (ppr bndr <+> ppr rhs) $ - simplLam env' body cont } - - -- Deal with strict bindings - | isStrictId bndr1 && seCaseCase env - || from_lam && needs_case_binding - -- The important bit here is needs_case_binds; but no need to - -- test it if from_lam is False because then needs_case_binding is False too - -- NB: either way, the RHS may or may not satisfy let-can-float - -- but that's ok for StrictBind. - -> simplExprF (rhs_se `setInScopeFromE` env) rhs - (StrictBind { sc_bndr = bndr, sc_body = body - , sc_env = env, sc_cont = cont, sc_dup = NoDup }) - - -- Deal with lazy bindings - | otherwise - -> do { (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) - ; (floats1, env3) <- simplLazyBind env2 NotTopLevel NonRecursive bndr bndr2 rhs rhs_se - ; (floats2, expr') <- simplLam env3 body cont - ; return (floats1 `addFloats` floats2, expr') } } +simplNonRecE env from_what bndr (rhs, rhs_se) body cont + | assert (isId bndr && not (isJoinId bndr) ) $ + is_strict_bind + = -- Evaluate RHS strictly + simplExprF (rhs_se `setInScopeFromE` env) rhs + (StrictBind { sc_bndr = bndr, sc_body = body, sc_from = from_what + , sc_env = env, sc_cont = cont, sc_dup = NoDup }) + + | otherwise -- Evaluate RHS lazily + = do { (env1, bndr1) <- simplNonRecBndr env bndr + ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) + ; (floats1, env3) <- simplLazyBind env2 NotTopLevel NonRecursive + bndr bndr2 rhs rhs_se + ; (floats2, expr') <- simplNonRecBody env3 from_what body cont + ; return (floats1 `addFloats` floats2, expr') } + + where + is_strict_bind = case from_what of + FromBeta arg_ty | isUnliftedType arg_ty -> True + -- If we are coming from a beta-reduction (FromBeta) we must + -- establish the let-can-float invariant, so go via StrictBind + -- If not, the invariant holds already, and it's optional. + -- Using arg_ty: see Note [Dark corner with representation polymorphism] + -- e.g (\r \(a::TYPE r) \(x::a). blah) @LiftedRep @Int arg + -- When we come to `x=arg` we myst choose lazy/strict correctly + -- It's wrong to err in either directly + + _ -> seCaseCase env && isStrUsedDmd (idDemandInfo bndr) + ------------------ simplRecE :: SimplEnv @@ -1835,7 +1869,7 @@ Note [Avoiding exponential behaviour] One way in which we can get exponential behaviour is if we simplify a big expression, and then re-simplify it -- and then this happens in a deeply-nested way. So we must be jolly careful about re-simplifying -an expression. That is why simplNonRecX does not try +an expression (#13379). That is why simplNonRecX does not try preInlineUnconditionally (unlike simplNonRecE). Example: @@ -2618,15 +2652,10 @@ Is this inefficient? Not really: we are about to walk over the result of the rule firing to simplify it, so occurrence analysis is at most a constant factor. -Possible improvement: occ-anal the rules when putting them in the -database; and in the simplifier just occ-anal the OutExpr arguments. -But that's more complicated and the rule RHS is usually tiny; so I'm -just doing the simple thing. - -Historical note: previously we did occ-anal the rules in Rule.hs, -but failed to occ-anal the OutExpr arguments, which led to the -nasty performance problem described above. - +Note, however, that the rule RHS is /already/ occ-analysed; see +Note [OccInfo in unfoldings and rules] in GHC.Core. There is something +unsatisfactory about doing it twice; but the rule RHS is usually very +small, and this is simple. Note [Optimising tagToEnum#] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2930,7 +2959,7 @@ rebuildCase env scrut case_bndr alts cont where simple_rhs env wfloats case_bndr_rhs bs rhs = assert (null bs) $ - do { (floats1, env') <- simplNonRecX env case_bndr case_bndr_rhs + do { (floats1, env') <- simplAuxBind env case_bndr case_bndr_rhs -- scrut is a constructor application, -- hence satisfies let-can-float invariant ; (floats2, expr') <- simplExprF env' rhs cont @@ -2997,7 +3026,7 @@ rebuildCase env scrut case_bndr alts@[Alt _ bndrs rhs] cont | all_dead_bndrs , doCaseToLet scrut case_bndr = do { tick (CaseElim case_bndr) - ; (floats1, env') <- simplNonRecX env case_bndr scrut + ; (floats1, env') <- simplAuxBind env case_bndr scrut ; (floats2, expr') <- simplExprF env' rhs cont ; return (floats1 `addFloats` floats2, expr') } @@ -3483,12 +3512,11 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont bind_args env' (b:bs') (arg : args) = assert (isId b) $ do { let b' = zap_occ b - -- Note that the binder might be "dead", because it doesn't - -- occur in the RHS; and simplNonRecX may therefore discard - -- it via postInlineUnconditionally. + -- zap_occ: the binder might be "dead", because it doesn't + -- occur in the RHS; and simplAuxBind may therefore discard it. -- Nevertheless we must keep it if the case-binder is alive, -- because it may be used in the con_app. See Note [knownCon occ info] - ; (floats1, env2) <- simplNonRecX env' b' arg -- arg satisfies let-can-float invariant + ; (floats1, env2) <- simplAuxBind env' b' arg -- arg satisfies let-can-float invariant ; (floats2, env3) <- bind_args env2 bs' args ; return (floats1 `addFloats` floats2, env3) } @@ -3514,7 +3542,7 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont ; let con_app = Var (dataConWorkId dc) `mkTyApps` dc_ty_args `mkApps` dc_args - ; simplNonRecX env bndr con_app } + ; simplAuxBind env bndr con_app } ------------------- missingAlt :: SimplEnv -> Id -> [InAlt] -> SimplCont @@ -3621,15 +3649,15 @@ mkDupableContWithDmds env dmds (TickIt t cont) ; return (floats, TickIt t cont') } mkDupableContWithDmds env _ - (StrictBind { sc_bndr = bndr, sc_body = body + (StrictBind { sc_bndr = bndr, sc_body = body, sc_from = from_what , sc_env = se, sc_cont = cont}) -- See Note [Duplicating StrictBind] -- K[ let x = <> in b ] --> join j x = K[ b ] -- j <> = do { let sb_env = se `setInScopeFromE` env ; (sb_env1, bndr') <- simplBinder sb_env bndr - ; (floats1, join_inner) <- simplLam sb_env1 body cont - -- No need to use mkDupableCont before simplLam; we + ; (floats1, join_inner) <- simplNonRecBody sb_env1 from_what body cont + -- No need to use mkDupableCont before simplNonRecBody; we -- use cont once here, and then share the result if necessary ; let join_body = wrapFloats floats1 join_inner @@ -3757,6 +3785,7 @@ mkDupableStrictBind env arg_bndr join_rhs res_ty , StrictBind { sc_bndr = arg_bndr , sc_body = join_rhs , sc_env = zapSubstEnv env + , sc_from = FromLet -- See Note [StaticEnv invariant] in GHC.Core.Opt.Simplify.Utils , sc_dup = OkToDup , sc_cont = mkBoringStop res_ty } ) @@ -4430,7 +4459,9 @@ simplRules env mb_new_id rules bind_cxt ; return (rule { ru_bndrs = bndrs' , ru_fn = fn_name' , ru_args = args' - , ru_rhs = rhs' }) } + , ru_rhs = occurAnalyseExpr rhs' }) } + -- Remember to occ-analyse, to drop dead code. + -- See Note [OccInfo in unfoldings and rules] in GHC.Core {- Note [Simplifying the RHS of a RULE] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -21,7 +21,7 @@ module GHC.Core.Opt.Simplify.Utils ( BindContext(..), bindContextLevel, -- The continuation type - SimplCont(..), DupFlag(..), StaticEnv, + SimplCont(..), DupFlag(..), FromWhat(..), StaticEnv, isSimplified, contIsStop, contIsDupable, contResultType, contHoleType, contHoleScaling, contIsTrivial, contArgs, contIsRhs, @@ -192,6 +192,7 @@ data SimplCont -- or, equivalently, = K[ (\x.b) e ] { sc_dup :: DupFlag -- See Note [DupFlag invariants] , sc_bndr :: InId + , sc_from :: FromWhat , sc_body :: InExpr , sc_env :: StaticEnv -- See Note [StaticEnv invariant] , sc_cont :: SimplCont } @@ -213,6 +214,8 @@ data SimplCont type StaticEnv = SimplEnv -- Just the static part is relevant +data FromWhat = FromLet | FromBeta OutType + -- See Note [DupFlag invariants] data DupFlag = NoDup -- Unsimplified, might be big | Simplified -- Simplified ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -63,6 +63,7 @@ import GHC.Core.Tidy ( tidyRules ) import GHC.Core.Map.Expr ( eqCoreExpr ) import GHC.Core.Opt.Arity( etaExpandToJoinPointRule ) import GHC.Core.Make ( mkCoreLams ) +import GHC.Core.Opt.OccurAnal( occurAnalyseExpr ) import GHC.Tc.Utils.TcType ( tcSplitTyConApp_maybe ) import GHC.Builtin.Types ( anyTypeOfKind ) @@ -189,13 +190,18 @@ mkRule :: Module -> Bool -> Bool -> RuleName -> Activation -- ^ Used to make 'CoreRule' for an 'Id' defined in the module being -- compiled. See also 'GHC.Core.CoreRule' mkRule this_mod is_auto is_local name act fn bndrs args rhs - = Rule { ru_name = name, ru_fn = fn, ru_act = act, - ru_bndrs = bndrs, ru_args = args, - ru_rhs = rhs, - ru_rough = roughTopNames args, - ru_origin = this_mod, - ru_orphan = orph, - ru_auto = is_auto, ru_local = is_local } + = Rule { ru_name = name + , ru_act = act + , ru_fn = fn + , ru_bndrs = bndrs + , ru_args = args + , ru_rhs = occurAnalyseExpr rhs + -- See Note [OccInfo in unfoldings and rules] + , ru_rough = roughTopNames args + , ru_origin = this_mod + , ru_orphan = orph + , ru_auto = is_auto + , ru_local = is_local } where -- Compute orphanhood. See Note [Orphans] in GHC.Core.InstEnv -- A rule is an orphan only if none of the variables ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -513,8 +513,8 @@ bindNonRec bndr rhs body -- | Tests whether we have to use a @case@ rather than @let@ binding for this -- expression as per the invariants of 'CoreExpr': see "GHC.Core#let_can_float_invariant" needsCaseBinding :: Type -> CoreExpr -> Bool -needsCaseBinding ty rhs = - mightBeUnliftedType ty && not (exprOkForSpeculation rhs) +needsCaseBinding ty rhs + = mightBeUnliftedType ty && not (exprOkForSpeculation rhs) -- Make a case expression instead of a let -- These can arise either from the desugarer, -- or from beta reductions: (\x.e) (x +# y) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4939,6 +4939,7 @@ needSourceNotes dflags = debugLevel dflags > 0 -- LinkerInfo contains any extra options needed by the system linker. data LinkerInfo = GnuLD [Option] + | Mold [Option] | GnuGold [Option] | LlvmLLD [Option] | DarwinLD [Option] ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -129,7 +129,11 @@ module GHC.JS.Make -- * Miscellaneous -- $misc , allocData, allocClsA - , dataFieldName, dataFieldNames + , dataName + , clsName + , dataFieldName + , varName + , jsClosureCount ) where @@ -142,10 +146,8 @@ import Control.Arrow ((***)) import Data.Array import qualified Data.Map as M -import GHC.Utils.Outputable (Outputable (..)) import GHC.Data.FastString import GHC.Utils.Monad.State.Strict -import GHC.Utils.Panic import GHC.Utils.Misc import GHC.Types.Unique.Map @@ -642,30 +644,48 @@ dataFieldCache :: Array Int FastString dataFieldCache = listArray (0,nFieldCache) (map (mkFastString . ('d':) . show) [(0::Int)..nFieldCache]) nFieldCache :: Int -nFieldCache = 16384 +nFieldCache = 255 + +jsClosureCount :: Int +jsClosureCount = 24 dataFieldName :: Int -> FastString dataFieldName i - | i < 1 || i > nFieldCache = panic "dataFieldName" (ppr i) + | i < 0 || i > nFieldCache = mkFastString ('d' : show i) | otherwise = dataFieldCache ! i -dataFieldNames :: [FastString] -dataFieldNames = fmap dataFieldName [1..nFieldCache] - - -- | Cache "h$dXXX" names dataCache :: Array Int FastString -dataCache = listArray (0,1024) (map (mkFastString . ("h$d"++) . show) [(0::Int)..1024]) +dataCache = listArray (0,jsClosureCount) (map (mkFastString . ("h$d"++) . show) [(0::Int)..jsClosureCount]) + +dataName :: Int -> FastString +dataName i + | i < 0 || i > nFieldCache = mkFastString ("h$d" ++ show i) + | otherwise = dataCache ! i allocData :: Int -> JExpr allocData i = toJExpr (TxtI (dataCache ! i)) -- | Cache "h$cXXX" names clsCache :: Array Int FastString -clsCache = listArray (0,1024) (map (mkFastString . ("h$c"++) . show) [(0::Int)..1024]) +clsCache = listArray (0,jsClosureCount) (map (mkFastString . ("h$c"++) . show) [(0::Int)..jsClosureCount]) + +clsName :: Int -> FastString +clsName i + | i < 0 || i > jsClosureCount = mkFastString ("h$c" ++ show i) + | otherwise = clsCache ! i allocClsA :: Int -> JExpr -allocClsA i = toJExpr (TxtI (clsCache ! i)) +allocClsA i = toJExpr (TxtI (clsName i)) + +-- | Cache "xXXX" names +varCache :: Array Int Ident +varCache = listArray (0,jsClosureCount) (map (TxtI . mkFastString . ('x':) . show) [(0::Int)..jsClosureCount]) + +varName :: Int -> Ident +varName i + | i < 0 || i > jsClosureCount = TxtI $ mkFastString ('x' : show i) + | otherwise = varCache ! i -------------------------------------------------------------------------------- ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -1006,7 +1006,7 @@ allocDynAll haveDecl middle cls = do ] (ex:es) -> mconcat [ toJExpr i .^ closureField1_ |= toJExpr ex - , toJExpr i .^ closureField2_ |= toJExpr (jhFromList (zip dataFieldNames es)) + , toJExpr i .^ closureField2_ |= toJExpr (jhFromList (zip (map dataFieldName [1..]) es)) ] | otherwise = case es of [] -> mempty ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -81,36 +81,8 @@ resetResultVar r = toJExpr r |= null_ -- JIT can optimize better. closureConstructors :: StgToJSConfig -> JStat closureConstructors s = BlockStat - [ declClsConstr "h$c" ["f"] $ Closure - { clEntry = var "f" - , clField1 = null_ - , clField2 = null_ - , clMeta = 0 - , clCC = ccVal - } - , declClsConstr "h$c0" ["f"] $ Closure - { clEntry = var "f" - , clField1 = null_ - , clField2 = null_ - , clMeta = 0 - , clCC = ccVal - } - , declClsConstr "h$c1" ["f", "x1"] $ Closure - { clEntry = var "f" - , clField1 = var "x1" - , clField2 = null_ - , clMeta = 0 - , clCC = ccVal - } - , declClsConstr "h$c2" ["f", "x1", "x2"] $ Closure - { clEntry = var "f" - , clField1 = var "x1" - , clField2 = var "x2" - , clMeta = 0 - , clCC = ccVal - } - , mconcat (map mkClosureCon [3..24]) - , mconcat (map mkDataFill [1..24]) + [ mconcat (map mkClosureCon (Nothing : map Just [0..jsClosureCount])) + , mconcat (map mkDataFill [1..jsClosureCount]) ] where prof = csProf s @@ -118,19 +90,8 @@ closureConstructors s = BlockStat -- the cc argument happens to be named just like the cc field... | prof = ([TxtI closureCC_], Just (var closureCC_)) | otherwise = ([], Nothing) - addCCArg as = map TxtI as ++ ccArg addCCArg' as = as ++ ccArg - declClsConstr i as cl = TxtI i ||= ValExpr (JFunc (addCCArg as) - ( jVar $ \x -> - [ checkC - , x |= newClosure cl - , notifyAlloc x - , traceAlloc x - , returnS x - ] - )) - traceAlloc x | csTraceRts s = appS "h$traceAlloc" [x] | otherwise = mempty @@ -172,26 +133,36 @@ closureConstructors s = BlockStat | otherwise = mempty - mkClosureCon :: Int -> JStat - mkClosureCon n = funName ||= toJExpr fun + mkClosureCon :: Maybe Int -> JStat + mkClosureCon n0 = funName ||= toJExpr fun where - funName = TxtI $ mkFastString ("h$c" ++ show n) + n | Just n' <- n0 = n' + | Nothing <- n0 = 0 + funName | Just n' <- n0 = TxtI $ clsName n' + | Nothing <- n0 = TxtI $ mkFastString "h$c" -- args are: f x1 x2 .. xn [cc] - args = TxtI "f" : addCCArg' (map (TxtI . mkFastString . ('x':) . show) [(1::Int)..n]) + args = TxtI "f" : addCCArg' (map varName [1..n]) fun = JFunc args funBod -- x1 goes into closureField1. All the other args are bundled into an -- object in closureField2: { d1 = x2, d2 = x3, ... } -- - extra_args = ValExpr . JHash . listToUniqMap $ zip - (map (mkFastString . ('d':) . show) [(1::Int)..]) - (map (toJExpr . TxtI . mkFastString . ('x':) . show) [2..n]) + vars = map (toJExpr . varName) [1..n] + + x1 = case vars of + [] -> null_ + x:_ -> x + x2 = case vars of + [] -> null_ + [_] -> null_ + [_,x] -> x + _:x:xs -> ValExpr . JHash . listToUniqMap $ zip (map dataFieldName [1..]) (x:xs) funBod = jVar $ \x -> [ checkC , x |= newClosure Closure { clEntry = var "f" - , clField1 = var "x1" - , clField2 = extra_args + , clField1 = x1 + , clField2 = x2 , clMeta = 0 , clCC = ccVal } @@ -203,8 +174,8 @@ closureConstructors s = BlockStat mkDataFill :: Int -> JStat mkDataFill n = funName ||= toJExpr fun where - funName = TxtI $ mkFastString ("h$d" ++ show n) - ds = map (mkFastString . ('d':) . show) [(1::Int)..n] + funName = TxtI $ dataName n + ds = map dataFieldName [1..n] extra_args = ValExpr . JHash . listToUniqMap . zip ds $ map (toJExpr . TxtI) ds fun = JFunc (map TxtI ds) (checkD <> returnS extra_args) @@ -215,7 +186,7 @@ stackManip = mconcat (map mkPush [1..32]) <> where mkPush :: Int -> JStat mkPush n = let funName = TxtI $ mkFastString ("h$p" ++ show n) - as = map (TxtI . mkFastString . ('x':) . show) [1..n] + as = map varName [1..n] fun = JFunc as ((sp |= sp + toJExpr n) <> mconcat (zipWith (\i a -> stack .! (sp - toJExpr (n-i)) |= toJExpr a) [1..] as)) @@ -228,7 +199,7 @@ stackManip = mconcat (map mkPush [1..32]) <> bits = bitsIdx sig n = length bits h = last bits - args = map (TxtI . mkFastString . ('x':) . show) [1..n] + args = map varName [1..n] fun = JFunc args $ mconcat [ sp |= sp + toJExpr (h+1) , mconcat (zipWith (\b a -> stack .! (sp - toJExpr (h-b)) |= toJExpr a) bits args) @@ -288,7 +259,7 @@ loadRegs :: JStat loadRegs = mconcat $ map mkLoad [1..32] where mkLoad :: Int -> JStat - mkLoad n = let args = map (TxtI . mkFastString . ("x"++) . show) [1..n] + mkLoad n = let args = map varName [1..n] assign = zipWith (\a r -> toJExpr r |= toJExpr a) args (reverse $ take n regsFromR1) fname = TxtI $ mkFastString ("h$l" ++ show n) ===================================== compiler/GHC/SysTools/Info.hs ===================================== @@ -70,6 +70,7 @@ The flag is only needed on ELF systems. On Windows (PE) and Mac OS X neededLinkArgs :: LinkerInfo -> [Option] neededLinkArgs (GnuLD o) = o +neededLinkArgs (Mold o) = o neededLinkArgs (GnuGold o) = o neededLinkArgs (LlvmLLD o) = o neededLinkArgs (DarwinLD o) = o @@ -106,6 +107,10 @@ getLinkerInfo' logger dflags = do -- see Note [ELF needed shared libs] "-Wl,--no-as-needed"]) + | any ("mold" `isPrefixOf`) stdo = + return (Mold $ map Option [ --see Note [ELF needed shared libs] + "-Wl,--no-as-needed"]) + | any ("GNU gold" `isPrefixOf`) stdo = -- GNU gold only needs --no-as-needed. #10110. -- ELF specific flag, see Note [ELF needed shared libs] ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -723,12 +723,14 @@ setIdCprSig id sig = modifyIdInfo (\info -> setCprSigInfo info sig) id zapIdDmdSig :: Id -> Id zapIdDmdSig id = modifyIdInfo (`setDmdSigInfo` nopSig) id --- | This predicate says whether the 'Id' has a strict demand placed on it or --- has a type such that it can always be evaluated strictly (i.e an --- unlifted type, as of GHC 7.6). We need to --- check separately whether the 'Id' has a so-called \"strict type\" because if --- the demand for the given @id@ hasn't been computed yet but @id@ has a strict --- type, we still want @isStrictId id@ to be @True at . +-- | `isStrictId` says whether either +-- (a) the 'Id' has a strict demand placed on it or +-- (b) definitely has a \"strict type\", such that it can always be +-- evaluated strictly (i.e an unlifted type) +-- We need to check (b) as well as (a), because when the demand for the +-- given `id` hasn't been computed yet but `id` has a strict +-- type, we still want `isStrictId id` to be `True`. +-- Returns False if the type is levity polymorphic; False is always safe. isStrictId :: Id -> Bool isStrictId id | assertPpr (isId id) (text "isStrictId: not an id: " <+> ppr id) $ ===================================== compiler/GHC/Unit/Module/ModIface.hs ===================================== @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE NamedFieldPuns #-} module GHC.Unit.Module.ModIface ( ModIface @@ -549,20 +550,58 @@ emptyIfaceHashCache _occ = Nothing -- Take care, this instance only forces to the degree necessary to -- avoid major space leaks. -instance (NFData (IfaceBackendExts (phase :: ModIfacePhase)), NFData (IfaceDeclExts (phase :: ModIfacePhase))) => NFData (ModIface_ phase) where - rnf (ModIface f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 - f13 f14 f15 f16 f17 f18 f19 f20 f21 f22 f23 f24) = - rnf f1 `seq` rnf f2 `seq` f3 `seq` f4 `seq` f5 `seq` f6 `seq` rnf f7 `seq` f8 `seq` - f9 `seq` rnf f10 `seq` rnf f11 `seq` rnf f12 `seq` f13 `seq` rnf f14 `seq` rnf f15 `seq` rnf f16 `seq` - rnf f17 `seq` f18 `seq` rnf f19 `seq` rnf f20 `seq` rnf f21 `seq` f22 `seq` f23 `seq` rnf f24 +instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase)) + , NFData (IfaceDeclExts (phase :: ModIfacePhase)) + ) => NFData (ModIface_ phase) where + rnf (ModIface{ mi_module, mi_sig_of, mi_hsc_src, mi_deps, mi_usages + , mi_exports, mi_used_th, mi_fixities, mi_warns, mi_anns + , mi_decls, mi_extra_decls, mi_globals, mi_insts + , mi_fam_insts, mi_rules, mi_hpc, mi_trust, mi_trust_pkg + , mi_complete_matches, mi_docs, mi_final_exts + , mi_ext_fields, mi_src_hash}) + = rnf mi_module + `seq` rnf mi_sig_of + `seq` mi_hsc_src + `seq` mi_deps + `seq` mi_usages + `seq` mi_exports + `seq` rnf mi_used_th + `seq` mi_fixities + `seq` mi_warns + `seq` rnf mi_anns + `seq` rnf mi_decls + `seq` rnf mi_extra_decls + `seq` mi_globals + `seq` rnf mi_insts + `seq` rnf mi_fam_insts + `seq` rnf mi_rules + `seq` rnf mi_hpc + `seq` mi_trust + `seq` rnf mi_trust_pkg + `seq` rnf mi_complete_matches + `seq` rnf mi_docs + `seq` mi_final_exts + `seq` mi_ext_fields + `seq` rnf mi_src_hash `seq` () - instance NFData (ModIfaceBackend) where - rnf (ModIfaceBackend f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13) - = rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` - rnf f5 `seq` rnf f6 `seq` rnf f7 `seq` rnf f8 `seq` - rnf f9 `seq` rnf f10 `seq` rnf f11 `seq` rnf f12 `seq` rnf f13 + rnf (ModIfaceBackend{ mi_iface_hash, mi_mod_hash, mi_flag_hash, mi_opt_hash + , mi_hpc_hash, mi_plugin_hash, mi_orphan, mi_finsts, mi_exp_hash + , mi_orphan_hash, mi_warn_fn, mi_fix_fn, mi_hash_fn}) + = rnf mi_iface_hash + `seq` rnf mi_mod_hash + `seq` rnf mi_flag_hash + `seq` rnf mi_opt_hash + `seq` rnf mi_hpc_hash + `seq` rnf mi_plugin_hash + `seq` rnf mi_orphan + `seq` rnf mi_finsts + `seq` rnf mi_exp_hash + `seq` rnf mi_orphan_hash + `seq` rnf mi_warn_fn + `seq` rnf mi_fix_fn + `seq` rnf mi_hash_fn forceModIface :: ModIface -> IO () ===================================== libraries/base/Data/OldList.hs ===================================== @@ -1511,7 +1511,7 @@ sortOn :: Ord b => (a -> b) -> [a] -> [a] sortOn f = map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x)) --- | Produce singleton list. +-- | Construct a list from a single element. -- -- >>> singleton True -- [True] ===================================== libraries/base/tests/all.T ===================================== @@ -79,7 +79,9 @@ test('length001', # excessive amounts of stack space. So we specifically set a low # stack limit and mark it as failing under a few conditions. [extra_run_opts('+RTS -K8m -RTS'), - expect_fail_for(['normal', 'threaded1', 'llvm', 'nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc'])], + expect_fail_for(['normal', 'threaded1', 'llvm', 'nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc']), + # JS doesn't support stack limit so the test sometimes passes just fine. We decrease the timeout duration to force the failure. + when(js_arch(), run_timeout_multiplier(0.2))], compile_and_run, ['']) test('ratio001', normal, compile_and_run, ['']) ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -31,6 +31,7 @@ module Language.Haskell.TH.Syntax -- $infix ) where +import qualified Data.Fixed as Fixed import Data.Data hiding (Fixity(..)) import Data.IORef import System.IO.Unsafe ( unsafePerformIO ) @@ -1056,6 +1057,15 @@ instance Lift Natural where liftTyped x = unsafeCodeCoerce (lift x) lift x = return (LitE (IntegerL (fromIntegral x))) +instance Lift (Fixed.Fixed a) where + liftTyped x = unsafeCodeCoerce (lift x) + lift (Fixed.MkFixed x) = do + ex <- lift x + return (ConE mkFixedName `AppE` ex) + where + mkFixedName = + mkNameG DataName "base" "Data.Fixed" "MkFixed" + instance Integral a => Lift (Ratio a) where liftTyped x = unsafeCodeCoerce (lift x) lift x = return (LitE (RationalL (toRational x))) ===================================== libraries/template-haskell/changelog.md ===================================== @@ -7,6 +7,7 @@ * Add `TypeDataD` constructor to the `Dec` type for `type data` declarations (GHC proposal #106). + * Add `instance Lift (Fixed a)` ## 2.19.0.0 ===================================== libraries/transformers ===================================== @@ -1 +1 @@ -Subproject commit ceff1dcd7893f7ab4abb6e66bcd248abd86c8886 +Subproject commit ef4fa181ebea77ac6997d392d1ef5a09524f06b2 ===================================== testsuite/driver/testlib.py ===================================== @@ -129,14 +129,17 @@ def no_deps( name, opts): def skip( name, opts ): opts.skip = True +def js_arch() -> bool: + return arch("javascript"); + # disable test on JS arch def js_skip( name, opts ): - if arch("javascript"): + if js_arch(): skip(name,opts) # expect broken for the JS backend def js_broken( bug: IssueNumber ): - if arch("javascript"): + if js_arch(): return expect_broken(bug); else: return normal; ===================================== testsuite/tests/driver/T1959/test.T ===================================== @@ -1 +1 @@ -test('T1959', [extra_files(['B.hs', 'C.hs', 'D.hs', 'E1.hs', 'E2.hs']), js_broken(22261)], makefile_test, ['dotest']) +test('T1959', [extra_files(['B.hs', 'C.hs', 'D.hs', 'E1.hs', 'E2.hs']), js_broken(22374)], makefile_test, ['dotest']) ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -167,10 +167,10 @@ test('T5594', [ omit_ways(['ghci']), ], compile_and_run, ['T5594_c.c -no-hs-main']) -test('Capi_Ctype_001', [extra_files(['Capi_Ctype_A_001.hsc', 'capi_ctype_001.h', 'capi_ctype_001_c.c']), js_broken(22374)], +test('Capi_Ctype_001', [extra_files(['Capi_Ctype_A_001.hsc', 'capi_ctype_001.h', 'capi_ctype_001_c.c']), req_c], makefile_test, ['Capi_Ctype_001']) -test('Capi_Ctype_002', [extra_files(['Capi_Ctype_A_002.hsc', 'capi_ctype_002_A.h', 'capi_ctype_002_B.h']), js_broken(22374)], +test('Capi_Ctype_002', [extra_files(['Capi_Ctype_A_002.hsc', 'capi_ctype_002_A.h', 'capi_ctype_002_B.h']), req_c], makefile_test, ['Capi_Ctype_002']) test('ffi_parsing_001', [omit_ways(['ghci']), req_c], compile_and_run, ===================================== testsuite/tests/rts/all.T ===================================== @@ -258,7 +258,7 @@ test('T6006', [ omit_ways(prof_ways + ['ghci']), # needs it. compile_and_run, ['T6006_c.c -no-hs-main']) -test('T7037', js_broken(22374), makefile_test, ['T7037']) +test('T7037', req_c, makefile_test, ['T7037']) test('T7087', exit_code(1), compile_and_run, ['']) test('T7160', [ omit_ways(['nonmoving_thr', 'nonmoving_thr_ghc']) ===================================== testsuite/tests/safeHaskell/check/pkg01/all.T ===================================== @@ -32,7 +32,7 @@ test('safePkg01', normalise_version("array", "ghc-bignum", "bytestring", "base", "deepseq", "ghc-prim"), normalise_fun(normalise_errmsg), - js_skip], + js_broken(22356)], run_command, ['$MAKE -s --no-print-directory safePkg01 ' + make_args]) # Fail since we enable package trust ===================================== testsuite/tests/simplCore/should_compile/T22761.hs ===================================== @@ -0,0 +1,40 @@ +module T22761 where + +import T22761a + +newtype Mod m = Mod m deriving Num + +gcdExt :: Integer -> (Integer, Integer) +gcdExt x = go 0 x + where + go !_ 0 = (1, 1) + go r _ = go r r + +pow :: (Num m) => Mod m -> Mod m +pow x = x*x*x +{-# NOINLINE [1] pow #-} +{-# RULES +"powMod/3/Int" forall x. pow x = x*x*x +#-} + + +-- GHC puts `boo1` after `wom1` (since they don't appear connected) +-- Then { wom1 = foo True } rewrites to { wom1 = boo False } +-- so we need to do glomming. And that triggers the bug +-- in the RULE for `pow`! +-- +-- wom2/boo2 are there to still elicit the bug if +-- GHC reverses its default ordering + +{-# RULES +"wombat1" foo True = boo1 False +#-} + +wom1 = foo True +boo1 x = x + +{-# RULES +"wombat2" foo True = boo2 False +#-} +boo2 x = x +wom2 = foo True ===================================== testsuite/tests/simplCore/should_compile/T22761a.hs ===================================== @@ -0,0 +1,4 @@ +module T22761a where + +{-# NOINLINE [0] foo #-} +foo x = x ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -152,7 +152,7 @@ test('T7702', # allocation done by the plugin... but a regression allocates > 90mb collect_compiler_stats('peak_megabytes_allocated',70), when(opsys('mingw32'), fragile_for(16799, ['normal'])), - js_skip + req_interp ], compile, ['-v0 -package-db T7702plugin/pkg.T7702/local.package.conf -fplugin T7702Plugin -package T7702plugin ' + config.plugin_way_flags]) @@ -471,5 +471,6 @@ test('T22611', [when(wordsize(32), skip), grep_errmsg(r'\$salterF') ], compile, test('T22715_2', normal, multimod_compile, ['T22715_2', '-v0 -O -fspecialise-aggressively']) test('T22802', normal, compile, ['-O']) test('T15205', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) +test('T22761', normal, multimod_compile, ['T22761', '-O2 -v0']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/70ef6b07d4adfc62b7d2cac4c7bc6a46b684490e...c0791ba37eeddd40b2935a9d8bf8a61dc0111728 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/70ef6b07d4adfc62b7d2cac4c7bc6a46b684490e...c0791ba37eeddd40b2935a9d8bf8a61dc0111728 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Feb 12 23:04:44 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 12 Feb 2023 18:04:44 -0500 Subject: [Git][ghc/ghc][wip/upload-ghc-libs] 105 commits: Detect family instance orphans correctly Message-ID: <63e9708cf23c4_50c521bff59a427805c@gitlab.mail> Ben Gamari pushed to branch wip/upload-ghc-libs at Glasgow Haskell Compiler / GHC Commits: 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - d65e9331 by Ben Gamari at 2023-02-12T23:04:35+00:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/upload_ghc_libs.py - cabal.project-reinstall - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Reg.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/BlockLayout.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fdc811916f3de6ceab655c22748619d925baf8a1...d65e9331b027ca36b80fedb8315916179c2311d9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fdc811916f3de6ceab655c22748619d925baf8a1...d65e9331b027ca36b80fedb8315916179c2311d9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Feb 12 23:07:27 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Sun, 12 Feb 2023 18:07:27 -0500 Subject: [Git][ghc/ghc] Deleted branch wip/mp-backports-batch-2 Message-ID: <63e9712faee1b_50c521a3876f0279935@gitlab.mail> Matthew Pickering deleted branch wip/mp-backports-batch-2 at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Feb 12 23:07:28 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 12 Feb 2023 18:07:28 -0500 Subject: [Git][ghc/ghc][ghc-9.6] 14 commits: Bump transformers to 0.6.1.0 Message-ID: <63e97130d0dc6_50c522304653c28018e@gitlab.mail> Ben Gamari pushed to branch ghc-9.6 at Glasgow Haskell Compiler / GHC Commits: ef79d013 by sheaf at 2023-02-09T12:47:50+00:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. (cherry picked from commit 2ea1a6bc7d7c2946b4a3d1c2c19083e09401f9f1) - - - - - b0dee831 by Cheng Shao at 2023-02-09T12:48:05+00:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. (cherry picked from commit 633f2799e697ddaf63c4c91820c0b5a7c9b17db7) - - - - - 5df968c3 by Cheng Shao at 2023-02-09T12:48:10+00:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. (cherry picked from commit ca6673e3cab496bbeed2ced47b40bcf1e0d0b3cd) - - - - - 03bc710d by Matthew Pickering at 2023-02-09T12:48:15+00:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- (cherry picked from commit 7eac2468a726f217dd97c5e2884f6b552e8ef11d) - - - - - 71decd09 by sheaf at 2023-02-09T12:49:01+00:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 (cherry picked from commit 9ee761bf02cdd11c955454a222c85971d95dce11) - - - - - 5dfa01e7 by Cheng Shao at 2023-02-09T12:49:30+00:00 docs: 9.6 release notes for wasm backend (cherry picked from commit 1ffe770c8d8c5c42edcf1558242f39431f72b965) - - - - - fcdf9f9b by Simon Peyton Jones at 2023-02-09T11:48:52-05:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 (cherry picked from commit 9f95db54e38b21782d058043abe42fd77abfb9ad) - - - - - bea77fc4 by Andreas Klebinger at 2023-02-09T12:05:36-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 (cherry picked from commit 382bd7dad9cd53254204f418190368667a127f64) - - - - - 31a90769 by Matthew Pickering at 2023-02-09T12:05:56-05:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. (cherry picked from commit cc72e71298ce7e8ef7a2263a531f96d777db1800) - - - - - 11686fb4 by Aaron Allen at 2023-02-09T12:06:01-05:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> (cherry picked from commit c31e87bbb13c0139b75acd234fd48eeb40cf50af) - - - - - 94844882 by Ben Gamari at 2023-02-09T12:06:40-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. (cherry picked from commit 6e52fcb915baa1acb38ad2b1f313e8e6a89899f5) - - - - - f63da175 by Ben Gamari at 2023-02-10T01:25:53-05:00 testsuite: Drop inapplicable tests These rely on TypeAbstractions, which is not implemented in 9.6.1. - - - - - f0da1dda by Ben Gamari at 2023-02-10T11:20:56-05:00 testsuite: Mark T15633 as fixed when static linking Fixes #20706 - - - - - bcc6c918 by Ben Gamari at 2023-02-10T11:23:08-05:00 relnotes: Mention release notes - - - - - 30 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Driver/Config/Stg/Pipeline.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Types.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/Tc/Gen/Pat.hs - docs/users_guide/9.6.1-notes.rst - ghc/Main.hs - libraries/transformers - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/driver/testutil.py - + testsuite/tests/gadt/T19847.hs - testsuite/tests/gadt/all.T - testsuite/tests/plugins/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bafa389975872e1dec6925e05ee0efc349656110...bcc6c918baf9164922813e4f05bd41854e274002 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bafa389975872e1dec6925e05ee0efc349656110...bcc6c918baf9164922813e4f05bd41854e274002 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Feb 12 23:07:40 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 12 Feb 2023 18:07:40 -0500 Subject: [Git][ghc/ghc][ghc-9.6] upload_ghc_libs: More control over which packages to operate on Message-ID: <63e9713c81ddc_50c521bff59a42803e2@gitlab.mail> Ben Gamari pushed to branch ghc-9.6 at Glasgow Haskell Compiler / GHC Commits: 3e18d493 by Ben Gamari at 2023-02-12T18:05:44-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - 1 changed file: - .gitlab/rel_eng/upload_ghc_libs.py Changes: ===================================== .gitlab/rel_eng/upload_ghc_libs.py ===================================== @@ -197,7 +197,7 @@ def main() -> None: parser_prepare.add_argument('--bindist', required=True, type=Path, help='extracted binary distribution') parser_upload = subparsers.add_parser('upload') - parser_upload.add_argument('--skip', nargs='*', type=str, help='skip uploading of the given package') + parser_upload.add_argument('--skip', default=[], action='append', type=str, help='skip uploading of the given package') parser_upload.add_argument('--docs', required = True, type=Path, help='folder created by --prepare') parser_upload.add_argument('--publish', action='store_true', help='Publish Hackage packages instead of just uploading candidates') args = parser.parse_args() @@ -212,7 +212,7 @@ def main() -> None: if args.command == "upload": for pkg_name in args.skip: assert pkg_name in PACKAGES - pkgs = pkgs - args.skip + pkgs = pkgs - set(args.skip) if args.command == "prepare": manifest = {} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e18d49314ba4b6e6a9e4f3428b9b873265cb9aa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e18d49314ba4b6e6a9e4f3428b9b873265cb9aa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 03:28:48 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Sun, 12 Feb 2023 22:28:48 -0500 Subject: [Git][ghc/ghc][wip/js-rts-fixmes] JS RTS: use jsClosureCount for closureConstructors and cache sizes Message-ID: <63e9ae7032250_50c521b2c4adc2872a7@gitlab.mail> Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC Commits: 2e2ea44c by Josh Meredith at 2023-02-13T03:28:22+00:00 JS RTS: use jsClosureCount for closureConstructors and cache sizes - - - - - 3 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -131,8 +131,9 @@ module GHC.JS.Make , allocData, allocClsA , dataName , clsName - , dataFieldName, dataFieldNames - , varName, varNames + , dataFieldName + , varName + , jsClosureCount ) where @@ -145,10 +146,8 @@ import Control.Arrow ((***)) import Data.Array import qualified Data.Map as M -import GHC.Utils.Outputable (Outputable (..)) import GHC.Data.FastString import GHC.Utils.Monad.State.Strict -import GHC.Utils.Panic import GHC.Utils.Misc import GHC.Types.Unique.Map @@ -645,52 +644,48 @@ dataFieldCache :: Array Int FastString dataFieldCache = listArray (0,nFieldCache) (map (mkFastString . ('d':) . show) [(0::Int)..nFieldCache]) nFieldCache :: Int -nFieldCache = 16384 +nFieldCache = 255 + +jsClosureCount :: Int +jsClosureCount = 24 dataFieldName :: Int -> FastString dataFieldName i - | i < 0 || i > nFieldCache = panic "dataFieldName" (ppr i) + | i < 0 || i > nFieldCache = mkFastString ('d' : show i) | otherwise = dataFieldCache ! i -dataFieldNames :: [FastString] -dataFieldNames = fmap dataFieldName [1..nFieldCache] - - -- | Cache "h$dXXX" names dataCache :: Array Int FastString -dataCache = listArray (0,63) (map (mkFastString . ("h$d"++) . show) [(0::Int)..63]) +dataCache = listArray (0,jsClosureCount) (map (mkFastString . ("h$d"++) . show) [(0::Int)..jsClosureCount]) dataName :: Int -> FastString dataName i - | i < 0 || i > 63 = panic "dataCacheName" (ppr i) - | otherwise = dataCache ! i + | i < 0 || i > nFieldCache = mkFastString ("h$d" ++ show i) + | otherwise = dataCache ! i allocData :: Int -> JExpr -allocData i = toJExpr (TxtI (dataCache ! i)) +allocData i = toJExpr (TxtI (dataCache i)) -- | Cache "h$cXXX" names clsCache :: Array Int FastString -clsCache = listArray (0,63) (map (mkFastString . ("h$c"++) . show) [(0::Int)..63]) +clsCache = listArray (0,jsClosureCount) (map (mkFastString . ("h$c"++) . show) [(0::Int)..jsClosureCount]) clsName :: Int -> FastString clsName i - | i < 0 || i > 63 = panic "clsCacheName" (ppr i) - | otherwise = clsCache ! i + | i < 0 || i > jsClosureCount = mkFastString ("h$c" ++ show i) + | otherwise = clsCache ! i allocClsA :: Int -> JExpr -allocClsA i = toJExpr (TxtI (clsCache ! i)) +allocClsA i = toJExpr (TxtI (clsName i)) -- | Cache "xXXX" names -varCache :: Array Int FastString -varCache = listArray (0,63) (map (mkFastString . ('x':) . show) [(0::Int)..63]) +varCache :: Array Int Ident +varCache = listArray (0,jsClosureCount) (map (TxtI . mkFastString . ('x':) . show) [(0::Int)..jsClosureCount]) varName :: Int -> Ident varName i - | i < 0 || i > 63 = panic "varCacheName" (ppr i) - | otherwise = TxtI $ varCache ! i - -varNames :: [Ident] -varNames = fmap varName [1..63] + | i < 0 || i > jsClosureCount = TxtI $ mkFastString ('x' : show i) + | otherwise = varCache ! i -------------------------------------------------------------------------------- ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -1006,7 +1006,7 @@ allocDynAll haveDecl middle cls = do ] (ex:es) -> mconcat [ toJExpr i .^ closureField1_ |= toJExpr ex - , toJExpr i .^ closureField2_ |= toJExpr (jhFromList (zip dataFieldNames es)) + , toJExpr i .^ closureField2_ |= toJExpr (jhFromList (zip (map dataFieldName [1..]) es)) ] | otherwise = case es of [] -> mempty ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -81,8 +81,8 @@ resetResultVar r = toJExpr r |= null_ -- JIT can optimize better. closureConstructors :: StgToJSConfig -> JStat closureConstructors s = BlockStat - [ mconcat (map mkClosureCon (Nothing : map Just [0..24])) - , mconcat (map mkDataFill [1..24]) + [ mconcat (map mkClosureCon (Nothing : map Just [0..jsClosureCount])) + , mconcat (map mkDataFill [1..jsClosureCount]) ] where prof = csProf s @@ -141,12 +141,12 @@ closureConstructors s = BlockStat funName | Just n' <- n0 = TxtI $ clsName n' | Nothing <- n0 = TxtI $ mkFastString "h$c" -- args are: f x1 x2 .. xn [cc] - args = TxtI "f" : addCCArg' (take n varNames) + args = TxtI "f" : addCCArg' (map varName [1..n]) fun = JFunc args funBod -- x1 goes into closureField1. All the other args are bundled into an -- object in closureField2: { d1 = x2, d2 = x3, ... } -- - vars = map toJExpr $ take n varNames + vars = map (toJExpr . varName) [1..n] x1 = case vars of [] -> null_ @@ -155,7 +155,7 @@ closureConstructors s = BlockStat [] -> null_ [_] -> null_ [_,x] -> x - _:x:xs -> ValExpr . JHash . listToUniqMap $ zip dataFieldNames (x:xs) + _:x:xs -> ValExpr . JHash . listToUniqMap $ zip (map dataFieldName [1..]) (x:xs) funBod = jVar $ \x -> [ checkC @@ -175,7 +175,7 @@ closureConstructors s = BlockStat mkDataFill n = funName ||= toJExpr fun where funName = TxtI $ dataName n - ds = take n dataFieldNames + ds = map dataFieldName [1..n] extra_args = ValExpr . JHash . listToUniqMap . zip ds $ map (toJExpr . TxtI) ds fun = JFunc (map TxtI ds) (checkD <> returnS extra_args) @@ -186,7 +186,7 @@ stackManip = mconcat (map mkPush [1..32]) <> where mkPush :: Int -> JStat mkPush n = let funName = TxtI $ mkFastString ("h$p" ++ show n) - as = take n varNames + as = map varName [1..n] fun = JFunc as ((sp |= sp + toJExpr n) <> mconcat (zipWith (\i a -> stack .! (sp - toJExpr (n-i)) |= toJExpr a) [1..] as)) @@ -199,7 +199,7 @@ stackManip = mconcat (map mkPush [1..32]) <> bits = bitsIdx sig n = length bits h = last bits - args = take n varNames + args = map varName [1..n] fun = JFunc args $ mconcat [ sp |= sp + toJExpr (h+1) , mconcat (zipWith (\b a -> stack .! (sp - toJExpr (h-b)) |= toJExpr a) bits args) @@ -259,7 +259,7 @@ loadRegs :: JStat loadRegs = mconcat $ map mkLoad [1..32] where mkLoad :: Int -> JStat - mkLoad n = let args = take n varNames + mkLoad n = let args = map varName [1..n] assign = zipWith (\a r -> toJExpr r |= toJExpr a) args (reverse $ take n regsFromR1) fname = TxtI $ mkFastString ("h$l" ++ show n) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2e2ea44c794f2550ea1c0dd7fb6b37f22b9ca896 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2e2ea44c794f2550ea1c0dd7fb6b37f22b9ca896 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 04:17:45 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Sun, 12 Feb 2023 23:17:45 -0500 Subject: [Git][ghc/ghc][wip/js-rts-fixmes] JS RTS: use jsClosureCount for closureConstructors and cache sizes Message-ID: <63e9b9e9e2fd3_50c5255118287924@gitlab.mail> Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC Commits: 799b247e by Josh Meredith at 2023-02-13T04:17:31+00:00 JS RTS: use jsClosureCount for closureConstructors and cache sizes - - - - - 3 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -131,8 +131,9 @@ module GHC.JS.Make , allocData, allocClsA , dataName , clsName - , dataFieldName, dataFieldNames - , varName, varNames + , dataFieldName + , varName + , jsClosureCount ) where @@ -145,10 +146,8 @@ import Control.Arrow ((***)) import Data.Array import qualified Data.Map as M -import GHC.Utils.Outputable (Outputable (..)) import GHC.Data.FastString import GHC.Utils.Monad.State.Strict -import GHC.Utils.Panic import GHC.Utils.Misc import GHC.Types.Unique.Map @@ -645,52 +644,48 @@ dataFieldCache :: Array Int FastString dataFieldCache = listArray (0,nFieldCache) (map (mkFastString . ('d':) . show) [(0::Int)..nFieldCache]) nFieldCache :: Int -nFieldCache = 16384 +nFieldCache = 255 + +jsClosureCount :: Int +jsClosureCount = 24 dataFieldName :: Int -> FastString dataFieldName i - | i < 0 || i > nFieldCache = panic "dataFieldName" (ppr i) + | i < 0 || i > nFieldCache = mkFastString ('d' : show i) | otherwise = dataFieldCache ! i -dataFieldNames :: [FastString] -dataFieldNames = fmap dataFieldName [1..nFieldCache] - - -- | Cache "h$dXXX" names dataCache :: Array Int FastString -dataCache = listArray (0,63) (map (mkFastString . ("h$d"++) . show) [(0::Int)..63]) +dataCache = listArray (0,jsClosureCount) (map (mkFastString . ("h$d"++) . show) [(0::Int)..jsClosureCount]) dataName :: Int -> FastString dataName i - | i < 0 || i > 63 = panic "dataCacheName" (ppr i) - | otherwise = dataCache ! i + | i < 0 || i > nFieldCache = mkFastString ("h$d" ++ show i) + | otherwise = dataCache ! i allocData :: Int -> JExpr -allocData i = toJExpr (TxtI (dataCache ! i)) +allocData i = toJExpr (TxtI (dataName i)) -- | Cache "h$cXXX" names clsCache :: Array Int FastString -clsCache = listArray (0,63) (map (mkFastString . ("h$c"++) . show) [(0::Int)..63]) +clsCache = listArray (0,jsClosureCount) (map (mkFastString . ("h$c"++) . show) [(0::Int)..jsClosureCount]) clsName :: Int -> FastString clsName i - | i < 0 || i > 63 = panic "clsCacheName" (ppr i) - | otherwise = clsCache ! i + | i < 0 || i > jsClosureCount = mkFastString ("h$c" ++ show i) + | otherwise = clsCache ! i allocClsA :: Int -> JExpr -allocClsA i = toJExpr (TxtI (clsCache ! i)) +allocClsA i = toJExpr (TxtI (clsName i)) -- | Cache "xXXX" names -varCache :: Array Int FastString -varCache = listArray (0,63) (map (mkFastString . ('x':) . show) [(0::Int)..63]) +varCache :: Array Int Ident +varCache = listArray (0,jsClosureCount) (map (TxtI . mkFastString . ('x':) . show) [(0::Int)..jsClosureCount]) varName :: Int -> Ident varName i - | i < 0 || i > 63 = panic "varCacheName" (ppr i) - | otherwise = TxtI $ varCache ! i - -varNames :: [Ident] -varNames = fmap varName [1..63] + | i < 0 || i > jsClosureCount = TxtI $ mkFastString ('x' : show i) + | otherwise = varCache ! i -------------------------------------------------------------------------------- ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -1006,7 +1006,7 @@ allocDynAll haveDecl middle cls = do ] (ex:es) -> mconcat [ toJExpr i .^ closureField1_ |= toJExpr ex - , toJExpr i .^ closureField2_ |= toJExpr (jhFromList (zip dataFieldNames es)) + , toJExpr i .^ closureField2_ |= toJExpr (jhFromList (zip (map dataFieldName [1..]) es)) ] | otherwise = case es of [] -> mempty ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -81,8 +81,8 @@ resetResultVar r = toJExpr r |= null_ -- JIT can optimize better. closureConstructors :: StgToJSConfig -> JStat closureConstructors s = BlockStat - [ mconcat (map mkClosureCon (Nothing : map Just [0..24])) - , mconcat (map mkDataFill [1..24]) + [ mconcat (map mkClosureCon (Nothing : map Just [0..jsClosureCount])) + , mconcat (map mkDataFill [1..jsClosureCount]) ] where prof = csProf s @@ -141,12 +141,12 @@ closureConstructors s = BlockStat funName | Just n' <- n0 = TxtI $ clsName n' | Nothing <- n0 = TxtI $ mkFastString "h$c" -- args are: f x1 x2 .. xn [cc] - args = TxtI "f" : addCCArg' (take n varNames) + args = TxtI "f" : addCCArg' (map varName [1..n]) fun = JFunc args funBod -- x1 goes into closureField1. All the other args are bundled into an -- object in closureField2: { d1 = x2, d2 = x3, ... } -- - vars = map toJExpr $ take n varNames + vars = map (toJExpr . varName) [1..n] x1 = case vars of [] -> null_ @@ -155,7 +155,7 @@ closureConstructors s = BlockStat [] -> null_ [_] -> null_ [_,x] -> x - _:x:xs -> ValExpr . JHash . listToUniqMap $ zip dataFieldNames (x:xs) + _:x:xs -> ValExpr . JHash . listToUniqMap $ zip (map dataFieldName [1..]) (x:xs) funBod = jVar $ \x -> [ checkC @@ -175,7 +175,7 @@ closureConstructors s = BlockStat mkDataFill n = funName ||= toJExpr fun where funName = TxtI $ dataName n - ds = take n dataFieldNames + ds = map dataFieldName [1..n] extra_args = ValExpr . JHash . listToUniqMap . zip ds $ map (toJExpr . TxtI) ds fun = JFunc (map TxtI ds) (checkD <> returnS extra_args) @@ -186,7 +186,7 @@ stackManip = mconcat (map mkPush [1..32]) <> where mkPush :: Int -> JStat mkPush n = let funName = TxtI $ mkFastString ("h$p" ++ show n) - as = take n varNames + as = map varName [1..n] fun = JFunc as ((sp |= sp + toJExpr n) <> mconcat (zipWith (\i a -> stack .! (sp - toJExpr (n-i)) |= toJExpr a) [1..] as)) @@ -199,7 +199,7 @@ stackManip = mconcat (map mkPush [1..32]) <> bits = bitsIdx sig n = length bits h = last bits - args = take n varNames + args = map varName [1..n] fun = JFunc args $ mconcat [ sp |= sp + toJExpr (h+1) , mconcat (zipWith (\b a -> stack .! (sp - toJExpr (h-b)) |= toJExpr a) bits args) @@ -259,7 +259,7 @@ loadRegs :: JStat loadRegs = mconcat $ map mkLoad [1..32] where mkLoad :: Int -> JStat - mkLoad n = let args = take n varNames + mkLoad n = let args = map varName [1..n] assign = zipWith (\a r -> toJExpr r |= toJExpr a) args (reverse $ take n regsFromR1) fname = TxtI $ mkFastString ("h$l" ++ show n) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/799b247e07a81af1a54d1bf5d6e3ecd1a6f020ba -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/799b247e07a81af1a54d1bf5d6e3ecd1a6f020ba You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 09:49:58 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Mon, 13 Feb 2023 04:49:58 -0500 Subject: [Git][ghc/ghc][wip/T22924] 8 commits: Update `Data.List.singleton` doc comment Message-ID: <63ea07c6bc298_50c521bff59a431559b@gitlab.mail> sheaf pushed to branch wip/T22924 at Glasgow Haskell Compiler / GHC Commits: d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - bc08cdb6 by Simon Peyton Jones at 2023-02-13T09:49:56+00:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 30 changed files: - .gitlab/merge_request_templates/merge-request.md - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Unit/Module/ModIface.hs - libraries/base/Data/OldList.hs - libraries/base/tests/all.T - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - libraries/template-haskell/changelog.md - testsuite/driver/testlib.py - + testsuite/tests/simplCore/should_compile/T22761.hs - + testsuite/tests/simplCore/should_compile/T22761a.hs - testsuite/tests/simplCore/should_compile/all.T - + testsuite/tests/typecheck/should_compile/T22924.hs - testsuite/tests/typecheck/should_compile/all.T - + testsuite/tests/typecheck/should_fail/T22924a.hs - + testsuite/tests/typecheck/should_fail/T22924a.stderr - + testsuite/tests/typecheck/should_fail/T22924b.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3bb8cc4d4841c4c050dd04986e0fe698f5616bab...bc08cdb67f416494b3c920a50fedb0b1942e0fda -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3bb8cc4d4841c4c050dd04986e0fe698f5616bab...bc08cdb67f416494b3c920a50fedb0b1942e0fda You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 10:37:01 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Mon, 13 Feb 2023 05:37:01 -0500 Subject: [Git][ghc/ghc][wip/profiling-docs-refresh] 107 commits: Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Message-ID: <63ea12cd15e0c_50c5255118325755@gitlab.mail> sheaf pushed to branch wip/profiling-docs-refresh at Glasgow Haskell Compiler / GHC Commits: 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - cabal.project-reinstall - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Reg.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/BlockLayout.hs - compiler/GHC/CmmToAsm/Dwarf.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e65802971a399f0fee9a9dd79c89483dcb57f699...da208b9aa03eaeec34528a7815d4d3451c106e18 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e65802971a399f0fee9a9dd79c89483dcb57f699...da208b9aa03eaeec34528a7815d4d3451c106e18 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 11:45:48 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 13 Feb 2023 06:45:48 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/ghci-prelude-is-implicit Message-ID: <63ea22eccb57c_50c5235e5038c354548@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/ghci-prelude-is-implicit at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/ghci-prelude-is-implicit You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 12:00:33 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 13 Feb 2023 07:00:33 -0500 Subject: [Git][ghc/ghc][wip/general-catgeory] unicode: Don't inline bitmap in generalCategory Message-ID: <63ea2661497bd_50c5232cddac035678d@gitlab.mail> Matthew Pickering pushed to branch wip/general-catgeory at Glasgow Haskell Compiler / GHC Commits: 400894c6 by Matthew Pickering at 2023-02-13T11:59:25+00:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 ------------------------- - - - - - 3 changed files: - libraries/base/GHC/Unicode/Internal/Char/UnicodeData/GeneralCategory.hs - libraries/base/changelog.md - libraries/base/tools/ucd2haskell/exe/Parser/Text.hs Changes: ===================================== libraries/base/GHC/Unicode/Internal/Char/UnicodeData/GeneralCategory.hs ===================================== The diff for this file was not included because it is too large. ===================================== libraries/base/changelog.md ===================================== @@ -4,6 +4,8 @@ * 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. + * Refactor `generalCategory` to stop very large literal string being inlined to call-sites. + ([CLC proposal #130](https://github.com/haskell/core-libraries-committee/issues/130)) ## 4.18.0.0 *TBA* * `Foreign.C.ConstPtr.ConstrPtr` was added to encode `const`-qualified ===================================== libraries/base/tools/ucd2haskell/exe/Parser/Text.hs ===================================== @@ -205,7 +205,11 @@ genEnumBitmap funcName def as = unlines <> show (length as) <> " then " <> show (fromEnum def) - <> " else lookupIntN bitmap# n" + <> " else lookup_bitmap n" + + , "{-# NOINLINE lookup_bitmap #-}" + , "lookup_bitmap :: Int -> Int" + , "lookup_bitmap n = lookupIntN bitmap# n" , " where" , " bitmap# = \"" <> enumMapToAddrLiteral as "\"#" ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/400894c68cbf93bcdcbdca2705ccadb8d2ddabff -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/400894c68cbf93bcdcbdca2705ccadb8d2ddabff You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 12:51:18 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Mon, 13 Feb 2023 07:51:18 -0500 Subject: [Git][ghc/ghc][wip/andreask/infer-bytecode] Apply 1 suggestion(s) to 1 file(s) Message-ID: <63ea3246c7a62_50c5232cddac03629bf@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/infer-bytecode at Glasgow Haskell Compiler / GHC Commits: bddfe477 by Krzysztof Gogolewski at 2023-02-13T12:51:17+00:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 1 changed file: - compiler/GHC/Stg/InferTags.hs Changes: ===================================== compiler/GHC/Stg/InferTags.hs ===================================== @@ -212,7 +212,7 @@ to the tagging of binders in certain situations than the StgToCmm code generator a) Tags for let-bindings: When compiling a binding for a constructor like `let x = Just True` - Weither or not `x` results in x pointing depends on the backend. + Whether `x` will be properly tagged depends on the backend. For the interpreter x points to a BCO which once evaluated returns a properly tagged pointer to the heap object. In the Cmm backend for the same binding we would allocate the constructor right View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bddfe477fb92549cff9d833d2a49af395177aab0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bddfe477fb92549cff9d833d2a49af395177aab0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 12:52:21 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Mon, 13 Feb 2023 07:52:21 -0500 Subject: [Git][ghc/ghc][wip/andreask/infer-bytecode] 48 commits: Improve treatment of type applications in patterns Message-ID: <63ea328578f89_50c521bff59a43647bf@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/infer-bytecode at Glasgow Haskell Compiler / GHC Commits: 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 75b87ef6 by Andreas Klebinger at 2023-02-13T13:51:47+01:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md - compiler/GHC.hs - compiler/GHC/CmmToLlvm/Mangler.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/List/SetOps.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Driver/Config/Stg/Pipeline.hs - compiler/GHC/Driver/Session.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bddfe477fb92549cff9d833d2a49af395177aab0...75b87ef65cda23ac48a48de485c7d229100144ea -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bddfe477fb92549cff9d833d2a49af395177aab0...75b87ef65cda23ac48a48de485c7d229100144ea You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 13:11:12 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 13 Feb 2023 08:11:12 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Add Lift instance for Fixed Message-ID: <63ea36f06b3b8_50c5255118374813@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - fc7e1561 by Bodigrim at 2023-02-13T08:11:02-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 8 changed files: - compiler/GHC/Unit/Module/ModIface.hs - docs/users_guide/debugging.rst - + docs/users_guide/images/eventlog_profile.png - docs/users_guide/profiling.rst - libraries/base/tests/all.T - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - libraries/template-haskell/changelog.md - testsuite/driver/testlib.py Changes: ===================================== compiler/GHC/Unit/Module/ModIface.hs ===================================== @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE NamedFieldPuns #-} module GHC.Unit.Module.ModIface ( ModIface @@ -549,20 +550,58 @@ emptyIfaceHashCache _occ = Nothing -- Take care, this instance only forces to the degree necessary to -- avoid major space leaks. -instance (NFData (IfaceBackendExts (phase :: ModIfacePhase)), NFData (IfaceDeclExts (phase :: ModIfacePhase))) => NFData (ModIface_ phase) where - rnf (ModIface f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 - f13 f14 f15 f16 f17 f18 f19 f20 f21 f22 f23 f24) = - rnf f1 `seq` rnf f2 `seq` f3 `seq` f4 `seq` f5 `seq` f6 `seq` rnf f7 `seq` f8 `seq` - f9 `seq` rnf f10 `seq` rnf f11 `seq` rnf f12 `seq` f13 `seq` rnf f14 `seq` rnf f15 `seq` rnf f16 `seq` - rnf f17 `seq` f18 `seq` rnf f19 `seq` rnf f20 `seq` rnf f21 `seq` f22 `seq` f23 `seq` rnf f24 +instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase)) + , NFData (IfaceDeclExts (phase :: ModIfacePhase)) + ) => NFData (ModIface_ phase) where + rnf (ModIface{ mi_module, mi_sig_of, mi_hsc_src, mi_deps, mi_usages + , mi_exports, mi_used_th, mi_fixities, mi_warns, mi_anns + , mi_decls, mi_extra_decls, mi_globals, mi_insts + , mi_fam_insts, mi_rules, mi_hpc, mi_trust, mi_trust_pkg + , mi_complete_matches, mi_docs, mi_final_exts + , mi_ext_fields, mi_src_hash}) + = rnf mi_module + `seq` rnf mi_sig_of + `seq` mi_hsc_src + `seq` mi_deps + `seq` mi_usages + `seq` mi_exports + `seq` rnf mi_used_th + `seq` mi_fixities + `seq` mi_warns + `seq` rnf mi_anns + `seq` rnf mi_decls + `seq` rnf mi_extra_decls + `seq` mi_globals + `seq` rnf mi_insts + `seq` rnf mi_fam_insts + `seq` rnf mi_rules + `seq` rnf mi_hpc + `seq` mi_trust + `seq` rnf mi_trust_pkg + `seq` rnf mi_complete_matches + `seq` rnf mi_docs + `seq` mi_final_exts + `seq` mi_ext_fields + `seq` rnf mi_src_hash `seq` () - instance NFData (ModIfaceBackend) where - rnf (ModIfaceBackend f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13) - = rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` - rnf f5 `seq` rnf f6 `seq` rnf f7 `seq` rnf f8 `seq` - rnf f9 `seq` rnf f10 `seq` rnf f11 `seq` rnf f12 `seq` rnf f13 + rnf (ModIfaceBackend{ mi_iface_hash, mi_mod_hash, mi_flag_hash, mi_opt_hash + , mi_hpc_hash, mi_plugin_hash, mi_orphan, mi_finsts, mi_exp_hash + , mi_orphan_hash, mi_warn_fn, mi_fix_fn, mi_hash_fn}) + = rnf mi_iface_hash + `seq` rnf mi_mod_hash + `seq` rnf mi_flag_hash + `seq` rnf mi_opt_hash + `seq` rnf mi_hpc_hash + `seq` rnf mi_plugin_hash + `seq` rnf mi_orphan + `seq` rnf mi_finsts + `seq` rnf mi_exp_hash + `seq` rnf mi_orphan_hash + `seq` rnf mi_warn_fn + `seq` rnf mi_fix_fn + `seq` rnf mi_hash_fn forceModIface :: ModIface -> IO () ===================================== docs/users_guide/debugging.rst ===================================== @@ -1046,6 +1046,8 @@ Checking for consistency :shortdesc: Align functions at given boundary. :type: dynamic + :since: 8.6.1 + Align functions to multiples of the given value. Only valid values are powers of two. ===================================== docs/users_guide/images/eventlog_profile.png ===================================== Binary files /dev/null and b/docs/users_guide/images/eventlog_profile.png differ ===================================== docs/users_guide/profiling.rst ===================================== @@ -10,17 +10,13 @@ Profiling GHC comes with a time and space profiling system, so that you can answer questions like "why is my program so slow?", or "why is my program using -so much memory?". +so much memory?". We'll start by describing how to do time profiling. -Profiling a program is a three-step process: +Time profiling a program is a three-step process: 1. Re-compile your program for profiling with the :ghc-flag:`-prof` option, and probably one of the options for adding automatic annotations: - :ghc-flag:`-fprof-auto` is the most common [1]_. - - If you are using external packages with :command:`cabal`, you may need to - reinstall these packages with profiling support; typically this is - done with ``cabal install -p package --reinstall``. + :ghc-flag:`-fprof-late` is the recommended option. 2. Having compiled the program for profiling, you now need to run it to generate the profile. For example, a simple time profile can be @@ -37,6 +33,9 @@ Profiling a program is a three-step process: 3. Examine the generated profiling information, use the information to optimise your program, and repeat as necessary. +The time profiler measures the CPU time taken by the Haskell code in your application. +In particular time taken by safe foreign calls is not tracked by the profiler (see :ref:`prof-foreign-calls`). + .. _cost-centres: Cost centres and cost-centre stacks @@ -197,7 +196,10 @@ Inserting cost centres by hand Cost centres are just program annotations. When you say ``-fprof-auto`` to the compiler, it automatically inserts a cost centre annotation around every binding not marked INLINE in your program, but you are -entirely free to add cost centre annotations yourself. +entirely free to add cost centre annotations yourself. Be careful adding too many +cost-centre annotations as the optimiser is careful to not move them around or +remove them, which can severly affect how your program is optimised and hence the +runtime performance! The syntax of a cost centre annotation for expressions is :: @@ -311,6 +313,39 @@ and become CAFs. You will probably need to consult the Core .. index:: single: -fprof-cafs +.. _prof-foreign-calls: + +Profiling and foreign calls +--------------------------- + +Simply put, the profiler includes time spent in unsafe foreign +calls but ignores time taken in safe foreign calls. For example, time spent blocked on IO +operations (e.g. ``getLine``) is not accounted for in the profile as ``getLine`` is implemented +using a safe foreign call. + +The profiler estimates CPU time, for Haskell threads within the program only. +In particular, time "taken" by the program in blocking safe foreign calls +is not accounted for in time profiles. The runtime has the notion of a virtual +processor which is known as a "capability". Haskell threads are run on capabilities, +and the profiler samples the capabilities in order to determine what is being +executed at a certain time. When a safe foreign call is executed, it's run outside +the context of a capability; hence the sampling does not account for the time +taken. Whilst the safe call is executed, other +Haskell threads are free to run on the capability, and their cost will be attributed +to the profiler. When the safe call is finished, the blocked, descheduled thread can +be resumed and rescheduled. + +However, the time taken by blocking on unsafe foreign calls is accounted for in the profile. +This happens because unsafe foreign calls are executed by the same capability +their calling Haskell thread is running on. Therefore, an unsafe foreign call will +block the entire capability whilst it is running, and any time the capability is +sampled the "cost" of the foreign call will be attributed to the calling cost-centre stack. + +However, do note that you are not supposed to use unsafe foreign calls for any +operations which do block! Do not be tempted to replace your safe foreign calls +with unsafe calls just so they appear in the profile. This prevents GC from +happening until the foreign call returns, which can be catastrophic for performance. + .. _prof-compiler-options: Compiler options for profiling @@ -356,7 +391,9 @@ Automatically placing cost-centres ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ GHC has a number of flags for automatically inserting cost-centres into the -compiled program. +compiled program. Use these options carefully because inserting too many cost-centres +in the wrong places will mean the optimiser will be less effective and the runtime behaviour +of your profiled program will be different to that of the unprofiled one. .. ghc-flag:: -fprof-callers=⟨name⟩ :shortdesc: Auto-add ``SCC``\\ s to all call-sites of the named function. @@ -618,8 +655,10 @@ enclosed between ``+RTS ... -RTS`` as usual): JSON profile format ~~~~~~~~~~~~~~~~~~~ -When invoked with the :rts-flag:`-pj` flag the runtime will emit the cost-centre -profile in a machine-readable JSON format. The top-level object of this format +profile in a machine-readable JSON format. The JSON file can be directly loaded +into `speedscope.app `_ to interactively view the profile. + +The top-level object of this format has the following properties, ``program`` (string) @@ -758,8 +797,12 @@ For instance, a simple profile might look like this, } } +Eventlog profile format +~~~~~~~~~~~~~~~~~~~~~~~ - +In addition to the ``.prof`` and ``.json`` formats the cost centre definitions +and samples are also emitted to the :ref:`eventlog `. The format +of the events is specified in the :ref:`eventlog encodings ` section. .. _prof-heap: @@ -774,18 +817,35 @@ program holds on to more memory at run-time that it needs to. Space leaks lead to slower execution due to heavy garbage collector activity, and may even cause the program to run out of memory altogether. +Heap profiling differs from time profiling in the fact that is not always +necessary to use the profiling runtime to generate a heap profile. There +are two heap profiling modes (:rts-flag:`-hT` and :rts-flag:`-hi` [1]_) which are always +available. + To generate a heap profile from your program: -1. Compile the program for profiling (:ref:`prof-compiler-options`). +1. Assuming you need the profiling runtime, compile the program for profiling (:ref:`prof-compiler-options`). 2. Run it with one of the heap profiling options described below (eg. - :rts-flag:`-hc` for a basic producer profile). This generates the file - :file:`{prog}.hp`. + :rts-flag:`-hc` for a basic producer profile) and enable the eventlog using :rts-flag:`-l <-l ⟨flags⟩>`. - If the :ref:`event log ` is enabled (with the :rts-flag:`-l ⟨flags⟩` - runtime system flag) heap samples will additionally be emitted to the GHC + Heap samples will be emitted to the GHC event log (see :ref:`heap-profiler-events` for details about event format). +3. Render the heap profile using `eventlog2html `_. + This produces an HTML file which contains the visualised profile. + +4. Open the rendered interactive profile in your web browser. + +For example, here is a heap profile produced of using eventlog profiling on GHC +compiling the Cabal library. You can read a lot more about eventlog2html on the website. + +.. image:: images/eventlog_profile.* + +Note that there is the legacy :file:`{prog}.hp` format which has been deprecated +in favour of eventlog based profiling. In order to render the legacy format, the +steps are as follows. + 3. Run :command:`hp2ps` to produce a Postscript file, :file:`{prog}.ps`. The :command:`hp2ps` utility is described in detail in :ref:`hp2ps`. @@ -797,10 +857,6 @@ from GHC's ``nofib`` benchmark suite, .. image:: images/prof_scc.* -You might also want to take a look at -`hp2any `__, a more advanced -suite of tools (not distributed with GHC) for displaying heap profiles. - Note that there might be a big difference between the OS reported memory usage of your program and the amount of live data as reported by heap profiling. The reasons for the difference are explained in :ref:`hints-os-memory`. @@ -817,20 +873,14 @@ following RTS options select which break-down to use: .. rts-flag:: -hT - Breaks down the graph by heap closure type. + Breaks down the graph by heap closure type. This does not require the profiling + runtime. .. rts-flag:: -hc - -h *Requires* :ghc-flag:`-prof`. Breaks down the graph by the cost-centre stack which produced the data. - .. note:: The meaning of the shortened :rts-flag:`-h` is dependent on whether - your program was compiled for profiling. When compiled for profiling, - :rts-flag:`-h` is equivalent to :rts-flag:`-hc`, but otherwise is - equivalent to :rts-flag:`-hT` (see :ref:`rts-profiling`). The :rts-flag:`-h` - is deprecated and will be removed in a future release. - .. rts-flag:: -hm *Requires* :ghc-flag:`-prof`. Break down the live heap by the module @@ -863,7 +913,7 @@ following RTS options select which break-down to use: Break down the graph by the address of the info table of a closure. For this to produce useful output the program must have been compiled with - :ghc-flag:`-finfo-table-map`. + :ghc-flag:`-finfo-table-map` but it does not require the profiling runtime. .. rts-flag:: -l :noindex: @@ -1041,6 +1091,14 @@ This trick isn't foolproof, because there might be other ``B`` closures in the heap which aren't the retainers we are interested in, but we've found this to be a useful technique in most cases. +Precise Retainer Analysis +~~~~~~~~~~~~~~~~~~~~~~~~~ + +If you want to precisely answer questions about why a certain type of closure is +retained then it is worthwhile using `ghc-debug `_ which +has a terminal interface which can be used to easily answer queries such as, what is retaining +a certain closure. + .. _biography-prof: Biographical Profiling @@ -1120,6 +1178,9 @@ reasons for this: allocated by foreign libraries, and data allocated by the RTS), and ``mmap()``\'d memory are not counted in the heap profile. +For more discussion about understanding how understanding process residency see +:ref:`hints-os-memory`. + .. _hp2ps: ``hp2ps`` -- Rendering heap profiles to PostScript @@ -1242,123 +1303,6 @@ The flags are: Print out usage information. -.. _manipulating-hp: - -Manipulating the ``hp`` file -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -(Notes kindly offered by Jan-Willem Maessen.) - -The ``FOO.hp`` file produced when you ask for the heap profile of a -program ``FOO`` is a text file with a particularly simple structure. -Here's a representative example, with much of the actual data omitted: - -.. code-block:: none - - JOB "FOO -hC" - DATE "Thu Dec 26 18:17 2002" - SAMPLE_UNIT "seconds" - VALUE_UNIT "bytes" - BEGIN_SAMPLE 0.00 - END_SAMPLE 0.00 - BEGIN_SAMPLE 15.07 - ... sample data ... - END_SAMPLE 15.07 - BEGIN_SAMPLE 30.23 - ... sample data ... - END_SAMPLE 30.23 - ... etc. - BEGIN_SAMPLE 11695.47 - END_SAMPLE 11695.47 - -The first four lines (``JOB``, ``DATE``, ``SAMPLE_UNIT``, -``VALUE_UNIT``) form a header. Each block of lines starting with -``BEGIN_SAMPLE`` and ending with ``END_SAMPLE`` forms a single sample -(you can think of this as a vertical slice of your heap profile). The -hp2ps utility should accept any input with a properly-formatted header -followed by a series of *complete* samples. - -Zooming in on regions of your profile -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -You can look at particular regions of your profile simply by loading a -copy of the ``.hp`` file into a text editor and deleting the unwanted -samples. The resulting ``.hp`` file can be run through ``hp2ps`` and -viewed or printed. - -Viewing the heap profile of a running program -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -The ``.hp`` file is generated incrementally as your program runs. In -principle, running :command:`hp2ps` on the incomplete file should produce a -snapshot of your program's heap usage. However, the last sample in the -file may be incomplete, causing :command:`hp2ps` to fail. If you are using a -machine with UNIX utilities installed, it's not too hard to work around -this problem (though the resulting command line looks rather Byzantine): - -.. code-block:: sh - - head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \ - | hp2ps > FOO.ps - -The command ``fgrep -n END_SAMPLE FOO.hp`` finds the end of every -complete sample in ``FOO.hp``, and labels each sample with its ending -line number. We then select the line number of the last complete sample -using :command:`tail` and :command:`cut`. This is used as a parameter to :command:`head`; the -result is as if we deleted the final incomplete sample from :file:`FOO.hp`. -This results in a properly-formatted .hp file which we feed directly to -:command:`hp2ps`. - -Viewing a heap profile in real time -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -The :command:`gv` and :command:`ghostview` programs have a "watch file" option -can be used to view an up-to-date heap profile of your program as it runs. -Simply generate an incremental heap profile as described in the previous -section. Run :command:`gv` on your profile: - -.. code-block:: sh - - gv -watch -orientation=seascape FOO.ps - -If you forget the ``-watch`` flag you can still select "Watch file" from -the "State" menu. Now each time you generate a new profile ``FOO.ps`` -the view will update automatically. - -This can all be encapsulated in a little script: - -.. code-block:: sh - - #!/bin/sh - head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \ - | hp2ps > FOO.ps - gv -watch -orientation=seascape FOO.ps & - while [ 1 ] ; do - sleep 10 # We generate a new profile every 10 seconds. - head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \ - | hp2ps > FOO.ps - done - -Occasionally :command:`gv` will choke as it tries to read an incomplete copy of -:file:`FOO.ps` (because :command:`hp2ps` is still running as an update occurs). A -slightly more complicated script works around this problem, by using the -fact that sending a SIGHUP to gv will cause it to re-read its input -file: - -.. code-block:: sh - - #!/bin/sh - head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \ - | hp2ps > FOO.ps - gv FOO.ps & - gvpsnum=$! - while [ 1 ] ; do - sleep 10 - head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \ - | hp2ps > FOO.ps - kill -HUP $gvpsnum - done - .. _prof-threaded: Profiling Parallel and Concurrent Programs @@ -1968,10 +1912,9 @@ Notes about ticky profiling in some columns. For this reason using an eventlog-based approach should be prefered if possible. - .. [1] - :ghc-flag:`-fprof-auto` was known as ``-auto-all`` prior to - GHC 7.4.1. + :rts-flag:`-hi` profiling is avaible with the normal runtime but you will need to + compile with :ghc-flag:`-finfo-table-map` to interpret the results. .. [2] Note that this policy has changed slightly in GHC 7.4.1 relative to ===================================== libraries/base/tests/all.T ===================================== @@ -79,7 +79,9 @@ test('length001', # excessive amounts of stack space. So we specifically set a low # stack limit and mark it as failing under a few conditions. [extra_run_opts('+RTS -K8m -RTS'), - expect_fail_for(['normal', 'threaded1', 'llvm', 'nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc'])], + expect_fail_for(['normal', 'threaded1', 'llvm', 'nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc']), + # JS doesn't support stack limit so the test sometimes passes just fine. We decrease the timeout duration to force the failure. + when(js_arch(), run_timeout_multiplier(0.2))], compile_and_run, ['']) test('ratio001', normal, compile_and_run, ['']) ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -31,6 +31,7 @@ module Language.Haskell.TH.Syntax -- $infix ) where +import qualified Data.Fixed as Fixed import Data.Data hiding (Fixity(..)) import Data.IORef import System.IO.Unsafe ( unsafePerformIO ) @@ -1056,6 +1057,15 @@ instance Lift Natural where liftTyped x = unsafeCodeCoerce (lift x) lift x = return (LitE (IntegerL (fromIntegral x))) +instance Lift (Fixed.Fixed a) where + liftTyped x = unsafeCodeCoerce (lift x) + lift (Fixed.MkFixed x) = do + ex <- lift x + return (ConE mkFixedName `AppE` ex) + where + mkFixedName = + mkNameG DataName "base" "Data.Fixed" "MkFixed" + instance Integral a => Lift (Ratio a) where liftTyped x = unsafeCodeCoerce (lift x) lift x = return (LitE (RationalL (toRational x))) ===================================== libraries/template-haskell/changelog.md ===================================== @@ -7,6 +7,7 @@ * Add `TypeDataD` constructor to the `Dec` type for `type data` declarations (GHC proposal #106). + * Add `instance Lift (Fixed a)` ## 2.19.0.0 ===================================== testsuite/driver/testlib.py ===================================== @@ -129,14 +129,17 @@ def no_deps( name, opts): def skip( name, opts ): opts.skip = True +def js_arch() -> bool: + return arch("javascript"); + # disable test on JS arch def js_skip( name, opts ): - if arch("javascript"): + if js_arch(): skip(name,opts) # expect broken for the JS backend def js_broken( bug: IssueNumber ): - if arch("javascript"): + if js_arch(): return expect_broken(bug); else: return normal; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c4faa59ad4de5e67904937410d24e742e8c7104c...fc7e15618be30db1599170b9ba95eecc4e9b2486 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c4faa59ad4de5e67904937410d24e742e8c7104c...fc7e15618be30db1599170b9ba95eecc4e9b2486 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 13:47:50 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 13 Feb 2023 08:47:50 -0500 Subject: [Git][ghc/ghc][wip/romes/ghci-prelude-is-implicit] fix: Mark ghci Prelude import as implicit Message-ID: <63ea3f867b193_26da845281410559@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/ghci-prelude-is-implicit at Glasgow Haskell Compiler / GHC Commits: 6379c129 by romes at 2023-02-13T13:47:13+00:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 4 changed files: - ghc/GHCi/UI.hs - testsuite/tests/ghci/scripts/ghci038.stdout - + testsuite/tests/ghci/should_run/T22829.hs - testsuite/tests/ghci/should_run/all.T Changes: ===================================== ghc/GHCi/UI.hs ===================================== @@ -556,7 +556,10 @@ interactiveUI config srcs maybe_exprs = do default_editor <- liftIO $ findEditor eval_wrapper <- mkEvalWrapper default_progname default_args - let prelude_import = simpleImportDecl preludeModuleName + let prelude_import = + case simpleImportDecl preludeModuleName of + -- Set to True because Prelude is implicitly imported. + impDecl at ImportDecl{ideclExt=ext} -> impDecl{ideclExt = ext{ideclImplicit=True}} hsc_env <- GHC.getSession let in_multi = length (hsc_all_home_unit_ids hsc_env) > 1 empty_cache <- liftIO newIfaceCache ===================================== testsuite/tests/ghci/scripts/ghci038.stdout ===================================== @@ -1,20 +1,20 @@ -import Prelude -- implicit +import (implicit) Prelude -- implicit import Prelude == map in scope due to explicit 'import Prelude' map :: (a -> b) -> [a] -> [b] import Prelude == still in scope, 'import Prelude ()' is subsumed by 'import Prelude' map :: (a -> b) -> [a] -> [b] -import Prelude -- implicit +import (implicit) Prelude -- implicit == still in scope, implicit import of Prelude map :: (a -> b) -> [a] -> [b] import Prelude () == not in scope now -import Prelude -- implicit +import (implicit) Prelude -- implicit x :: (a -> b) -> [a] -> [b] :module +*Foo -- added automatically :m -Foo -import Prelude -- implicit +import (implicit) Prelude -- implicit :m +*Foo :module +*Foo x :: (a -> b) -> [a] -> [b] ===================================== testsuite/tests/ghci/should_run/T22829.hs ===================================== @@ -0,0 +1,2 @@ +-- Do nothing, we simply want to load Prelude in ghci with -Wmissing-import-lists and -Werror +main = pure () ===================================== testsuite/tests/ghci/should_run/all.T ===================================== @@ -87,3 +87,4 @@ test('T21300', just_ghci, ghci_script, ['T21300.script']) test('UnliftedDataType2', just_ghci, compile_and_run, ['']) test('SizedLiterals', [req_interp, extra_files(["SizedLiteralsA.hs"]),extra_hc_opts("-O -fbyte-code-and-object-code -fprefer-byte-code")], compile_and_run, ['']) +test('T22829', just_ghci + [extra_hc_opts("-Wmissing-import-lists -Werror")], compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6379c129157eaf516ecc031677b81f24477109b3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6379c129157eaf516ecc031677b81f24477109b3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 14:16:01 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Mon, 13 Feb 2023 09:16:01 -0500 Subject: [Git][ghc/ghc][wip/T22756] 205 commits: Bump submodule bytestring to 0.11.4.0 Message-ID: <63ea462144476_26da84527ec58427@gitlab.mail> Andreas Klebinger pushed to branch wip/T22756 at Glasgow Haskell Compiler / GHC Commits: 9a3d6add by Bodigrim at 2023-01-13T00:46:36-05:00 Bump submodule bytestring to 0.11.4.0 Metric Decrease: T21839c T21839r - - - - - df33c13c by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Bump Darwin bootstrap toolchain This updates the bootstrap compiler on Darwin from 8.10.7 to 9.2.5, ensuring that we have the fix for #21964. - - - - - 756a66ec by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Pass -w to cabal update Due to cabal#8447, cabal-install 3.8.1.0 requires a compiler to run `cabal update`. - - - - - 1142f858 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump hsc2hs submodule - - - - - d4686729 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump process submodule - - - - - 84ae6573 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: Bump DOCKER_REV - - - - - d53598c5 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: enable xz parallel compression for x64 jobs - - - - - d31fcbca by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: use in-image emsdk for js jobs - - - - - 93b9bbc1 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: improve nix-shell for gen_ci.hs and fix some ghc/hlint warnings - Add a ghc environment including prebuilt dependencies to the nix-shell. Get rid of the ad hoc cabal cache and all dependencies are now downloaded from the nixos binary cache. - Make gen_ci.hs a cabal package with HLS integration, to make future hacking of gen_ci.hs easier. - Fix some ghc/hlint warnings after I got HLS to work. - For the lint-ci-config job, do a shallow clone to save a few minutes of unnecessary git checkout time. - - - - - 8acc56c7 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: source the toolchain env file in wasm jobs - - - - - 87194df0 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: add wasm ci jobs via gen_ci.hs - There is one regular wasm job run in validate pipelines - Additionally, int-native/unreg wasm jobs run in nightly/release pipelines Also, remove the legacy handwritten wasm ci jobs in .gitlab-ci.yml. - - - - - b6eb9bcc by Matthew Pickering at 2023-01-13T11:52:16+00:00 wasm ci: Remove wasm release jobs This removes the wasm release jobs, as we do not yet intend to distribute these binaries. - - - - - 496607fd by Simon Peyton Jones at 2023-01-13T16:52:07-05:00 Add a missing checkEscapingKind Ticket #22743 pointed out that there is a missing check, for type-inferred bindings, that the inferred type doesn't have an escaping kind. The fix is easy. - - - - - 7a9a1042 by Andreas Klebinger at 2023-01-16T20:48:19-05:00 Separate core inlining logic from `Unfolding` type. This seems like a good idea either way, but is mostly motivated by a patch where this avoids a module loop. - - - - - 33b58f77 by sheaf at 2023-01-16T20:48:57-05:00 Hadrian: generalise &%> to avoid warnings This patch introduces a more general version of &%> that works with general traversable shapes, instead of lists. This allows us to pass along the information that the length of the list of filepaths passed to the function exactly matches the length of the input list of filepath patterns, avoiding pattern match warnings. Fixes #22430 - - - - - 8c7a991c by Andreas Klebinger at 2023-01-16T20:49:34-05:00 Add regression test for #22611. A case were a function used to fail to specialize, but now does. - - - - - 6abea760 by Andreas Klebinger at 2023-01-16T20:50:10-05:00 Mark maximumBy/minimumBy as INLINE. The RHS was too large to inline which often prevented the overhead of the Maybe from being optimized away. By marking it as INLINE we can eliminate the overhead of both the maybe and are able to unpack the accumulator when possible. Fixes #22609 - - - - - 99d151bb by Matthew Pickering at 2023-01-16T20:50:50-05:00 ci: Bump CACHE_REV so that ghc-9.6 branch and HEAD have different caches Having the same CACHE_REV on both branches leads to issues where the darwin toolchain is different on ghc-9.6 and HEAD which leads to long darwin build times. In general we should ensure that each branch has a different CACHE_REV. - - - - - 6a5845fb by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in source-tarball job This fixes errors of the form: ``` fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc inferred 9.7.20230113 checking for GHC Git commit id... fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc ``` - - - - - 4afb952c by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't build aarch64-deb10-llvm job on release pipelines Closes #22721 - - - - - 8039feb9 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in test-bootstrap job - - - - - 0b358d0c by Matthew Pickering at 2023-01-16T20:51:25-05:00 rel_eng: Add release engineering scripts into ghc tree It is better to keep these scripts in the tree as they depend on the CI configuration and so on. By keeping them in tree we can keep them up-to-date as the CI config changes and also makes it easier to backport changes to the release script between release branches in future. The final motivation is that it makes generating GHCUp metadata possible. - - - - - 28cb2ed0 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't use complicated image or clone in not-interruptible job This job exists only for the meta-reason of not allowing nightly pipelines to be cancelled. It was taking two minutes to run as in order to run "true" we would also clone the whole GHC repo. - - - - - eeea59bb by Matthew Pickering at 2023-01-16T20:51:26-05:00 Add scripts to generate ghcup metadata on nightly and release pipelines 1. A python script in .gitlab/rel_eng/mk-ghcup-metadata which generates suitable metadata for consumption by GHCUp for the relevant pipelines. - The script generates the metadata just as the ghcup maintainers want, without taking into account platform/library combinations. It is updated manually when the mapping changes. - The script downloads the bindists which ghcup wants to distribute, calculates the hash and generates the yaml in the correct structure. - The script is documented in the .gitlab/rel_eng/mk-ghcup-metadata/README.mk file 1a. The script requires us to understand the mapping from platform -> job. To choose the preferred bindist for each platform the .gitlab/gen_ci.hs script is modified to allow outputting a metadata file which answers the question about which job produces the bindist which we want to distribute to users for a specific platform. 2. Pipelines to run on nightly and release jobs to generate metadata - ghcup-metadata-nightly: Generates metadata which points directly to artifacts in the nightly job. - ghcup-metadata-release: Generates metadata suitable for inclusion directly in ghcup by pointing to the downloads folder where the bindist will be uploaded to. 2a. Trigger jobs which test the generated metadata in the downstream `ghccup-ci` repo. See that repo for documentation about what is tested and how but essentially we test in a variety of clean images that ghcup can download and install the bindists we say exist in our metadata. - - - - - 97bd4d8c by Bodigrim at 2023-01-16T20:52:04-05:00 Bump submodule parsec to 3.1.16.1 - - - - - 97ac8230 by Alan Zimmerman at 2023-01-16T20:52:39-05:00 EPA: Add annotation for 'type' in DataDecl Closes #22765 - - - - - dbbab95d by Ben Gamari at 2023-01-17T06:36:06-05:00 compiler: Small optimisation of assertM In #22739 @AndreasK noticed that assertM performed the action to compute the asserted predicate regardless of whether DEBUG is enabled. This is inconsistent with the other assertion operations and general convention. Fix this. Closes #22739. - - - - - fc02f3bb by Viktor Dukhovni at 2023-01-17T06:36:47-05:00 Avoid unnecessary printf warnings in EventLog.c Fixes #22778 - - - - - 003b6d44 by Simon Peyton Jones at 2023-01-17T16:33:05-05:00 Document the semantics of pattern bindings a bit better This MR is in response to the discussion on #22719 - - - - - f4d50baf by Vladislav Zavialov at 2023-01-17T16:33:41-05:00 Hadrian: fix warnings (#22783) This change fixes the following warnings when building Hadrian: src/Hadrian/Expression.hs:38:10: warning: [-Wredundant-constraints] src/Hadrian/Expression.hs:84:13: warning: [-Wtype-equality-requires-operators] src/Hadrian/Expression.hs:84:21: warning: [-Wtype-equality-requires-operators] src/Hadrian/Haskell/Cabal/Parse.hs:67:1: warning: [-Wunused-imports] - - - - - 06036d93 by Sylvain Henry at 2023-01-18T01:55:10-05:00 testsuite: req_smp --> req_target_smp, req_ghc_smp See #22630 and !9552 This commit: - splits req_smp into req_target_smp and req_ghc_smp - changes the testsuite driver to calculate req_ghc_smp - changes a handful of tests to use req_target_smp instead of req_smp - changes a handful of tests to use req_host_smp when needed The problem: - the problem this solves is the ambiguity surrounding req_smp - on master req_smp was used to express the constraint that the program being compiled supports smp _and_ that the host RTS (i.e., the RTS used to compile the program) supported smp. Normally that is fine, but in cross compilation this is not always the case as was discovered in #22630. The solution: - Differentiate the two constraints: - use req_target_smp to say the RTS the compiled program is linked with (and the platform) supports smp - use req_host_smp to say the RTS the host is linked with supports smp WIP: fix req_smp (target vs ghc) add flag to separate bootstrapper split req_smp -> req_target_smp and req_ghc_smp update tests smp flags cleanup and add some docstrings only set ghc_with_smp to bootstrapper on S1 or CC Only set ghc_with_smp to bootstrapperWithSMP of when testing stage 1 and cross compiling test the RTS in config/ghc not hadrian re-add ghc_with_smp fix and align req names fix T11760 to use req_host_smp test the rts directly, avoid python 3.5 limitation test the compiler in a try block align out of tree and in tree withSMP flags mark failing tests as host req smp testsuite: req_host_smp --> req_ghc_smp Fix ghc vs host, fix ghc_with_smp leftover - - - - - ee9b78aa by Krzysztof Gogolewski at 2023-01-18T01:55:45-05:00 Use -Wdefault when running Python testdriver (#22727) - - - - - e9c0537c by Vladislav Zavialov at 2023-01-18T01:56:22-05:00 Enable -Wstar-is-type by default (#22759) Following the plan in GHC Proposal #143 "Remove the * kind syntax", which states: In the next release (or 3 years in), enable -fwarn-star-is-type by default. The "next release" happens to be 9.6.1 I also moved the T21583 test case from should_fail to should_compile, because the only reason it was failing was -Werror=compat in our test suite configuration. - - - - - 4efee43d by Ryan Scott at 2023-01-18T01:56:59-05:00 Add missing parenthesizeHsType in cvtSigTypeKind We need to ensure that the output of `cvtSigTypeKind` is parenthesized (at precedence `sigPrec`) so that any type signatures with an outermost, explicit kind signature can parse correctly. Fixes #22784. - - - - - f891a442 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. - - - - - b13c6ea5 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. - - - - - c45a5fff by Cheng Shao at 2023-01-18T07:28:37-05:00 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. - - - - - b4c14c4b by Luite Stegeman at 2023-01-18T14:21:42-05:00 Add PrimCallConv support to GHCi This adds support for calling Cmm code from bytecode using the native calling convention, allowing modules that use `foreign import prim` to be loaded and debugged in GHCi. This patch introduces a new `PRIMCALL` bytecode instruction and a helper stack frame `stg_primcall`. The code is based on the existing functionality for dealing with unboxed tuples in bytecode, which has been generalised to handle arbitrary calls. Fixes #22051 - - - - - d0a63ef8 by Adam Gundry at 2023-01-18T14:22:26-05:00 Refactor warning flag parsing to add missing flags This adds `-Werror=<group>` and `-fwarn-<group>` flags for warning groups as well as individual warnings. Previously these were defined on an ad hoc basis so for example we had `-Werror=compat` but not `-Werror=unused-binds`, whereas we had `-fwarn-unused-binds` but not `-fwarn-compat`. Fixes #22182. - - - - - 7ed1b8ef by Adam Gundry at 2023-01-18T14:22:26-05:00 Minor corrections to comments - - - - - 5389681e by Adam Gundry at 2023-01-18T14:22:26-05:00 Revise warnings documentation in user's guide - - - - - ab0d5cda by Adam Gundry at 2023-01-18T14:22:26-05:00 Move documentation of deferred type error flags out of warnings section - - - - - eb5a6b91 by John Ericson at 2023-01-18T22:24:10-05:00 Give the RTS it's own configure script Currently it doesn't do much anything, we are just trying to introduce it without breaking the build. Later, we will move functionality from the top-level configure script over to it. We need to bump Cabal for https://github.com/haskell/cabal/pull/8649; to facilitate and existing hack of skipping some configure checks for the RTS we now need to skip just *part* not *all* of the "post configure" hook, as running the configure script (which we definitely want to do) is also implemented as part of the "post configure" hook. But doing this requires exposing functionality that wasn't exposed before. - - - - - 32ab07bf by Bodigrim at 2023-01-18T22:24:51-05:00 ghc package does not have to depend on terminfo - - - - - 981ff7c4 by Bodigrim at 2023-01-18T22:24:51-05:00 ghc-pkg does not have to depend on terminfo - - - - - f058e367 by Ben Gamari at 2023-01-18T22:25:27-05:00 nativeGen/X86: MFENCE is unnecessary for release semantics In #22764 a user noticed that a program implementing a simple atomic counter via an STRef regressed significantly due to the introduction of necessary atomic operations in the MutVar# primops (#22468). This regression was caused by a bug in the NCG, which emitted an unnecessary MFENCE instruction for a release-ordered atomic write. MFENCE is rather only needed to achieve sequentially consistent ordering. Fixes #22764. - - - - - 154889db by Ryan Scott at 2023-01-18T22:26:03-05:00 Add regression test for #22151 Issue #22151 was coincidentally fixed in commit aed1974e92366ab8e117734f308505684f70cddf (`Refactor the treatment of loopy superclass dicts`). This adds a regression test to ensure that the issue remains fixed. Fixes #22151. - - - - - 14b5982a by Andrei Borzenkov at 2023-01-18T22:26:43-05:00 Fix printing of promoted MkSolo datacon (#22785) Problem: In 2463df2f, the Solo data constructor was renamed to MkSolo, and Solo was turned into a pattern synonym for backwards compatibility. Since pattern synonyms can not be promoted, the old code that pretty-printed promoted single-element tuples started producing ill-typed code: t :: Proxy ('Solo Int) This fails with "Pattern synonym ‘Solo’ used as a type" The solution is to track the distinction between type constructors and data constructors more carefully when printing single-element tuples. - - - - - 1fe806d3 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add hi_core flavour transformer The hi_core flavour transformer enables -fwrite-if-simplified-core for stage1 libraries, which emit core into interface files to make it possible to restart code generation. Building boot libs with it makes it easier to use GHC API to prototype experimental backends that needs core/stg at link time. - - - - - 317cad26 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add missing docs for recently added flavour transformers - - - - - 658f4446 by Ben Gamari at 2023-01-23T04:49:23-05:00 gitlab-ci: Add Rocky8 jobs Addresses #22268. - - - - - a83ec778 by Vladislav Zavialov at 2023-01-23T04:49:58-05:00 Set "since: 9.8" for TypeAbstractions and -Wterm-variable-capture These flags did not make it into the 9.6 release series, so the "since" annotations must be corrected. - - - - - fec7c2ea by Alan Zimmerman at 2023-01-23T04:50:33-05:00 EPA: Add SourceText to HsOverLabel To be able to capture string literals with possible escape codes as labels. Close #22771 - - - - - 3efd1e99 by Ben Gamari at 2023-01-23T04:51:08-05:00 template-haskell: Bump version to 2.20.0.0 Updates `text` and `exceptions` submodules for bounds bumps. Addresses #22767. - - - - - 0900b584 by Cheng Shao at 2023-01-23T04:51:45-05:00 hadrian: disable alloca for in-tree GMP on wasm32 When building in-tree GMP for wasm32, disable its alloca usage, since it may potentially cause stack overflow (e.g. #22602). - - - - - db0f1bfd by Cheng Shao at 2023-01-23T04:52:21-05:00 Bump process submodule Includes a critical fix for wasm32, see https://github.com/haskell/process/pull/272 for details. Also changes the existing cross test to include process stuff and avoid future regression here. - - - - - 9222b167 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Fix subdir for windows bindist - - - - - 9a9bec57 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Remove viPostRemove field from generated metadata This has been removed from the downstream metadata. - - - - - 82884ce0 by Simon Peyton Jones at 2023-01-23T04:53:32-05:00 Fix #22742 runtimeRepLevity_maybe was panicing unnecessarily; and the error printing code made use of the case when it should return Nothing rather than panicing. For some bizarre reason perf/compiler/T21839r shows a 10% bump in runtime peak-megagbytes-used, on a single architecture (alpine). See !9753 for commentary, but I'm going to accept it. Metric Increase: T21839r - - - - - 2c6deb18 by Bryan Richter at 2023-01-23T14:12:22+02:00 codeowners: Add Ben, Matt, and Bryan to CI - - - - - eee3bf05 by Matthew Craven at 2023-01-23T21:46:41-05:00 Do not collect compile-time metrics for T21839r ...the testsuite doesn't handle this properly since it also collects run-time metrics. Compile-time metrics for this test are already tracked via T21839c. Metric Decrease: T21839r - - - - - 1d1dd3fb by Matthew Pickering at 2023-01-24T05:37:52-05:00 Fix recompilation checking for multiple home units The key part of this change is to store a UnitId in the `UsageHomeModule` and `UsageHomeModuleInterface`. * Fine-grained dependency tracking is used if the dependency comes from any home unit. * We actually look up the right module when checking whether we need to recompile in the `UsageHomeModuleInterface` case. These scenarios are both checked by the new tests ( multipleHomeUnits_recomp and multipleHomeUnits_recomp_th ) Fixes #22675 - - - - - 7bfb30f9 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Augment target filepath by working directory when checking if module satisfies target This fixes a spurious warning in -Wmissing-home-modules. This is a simple oversight where when looking for the target in the first place we augment the search by the -working-directory flag but then fail to do so when checking this warning. Fixes #22676 - - - - - 69500dd4 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Use NodeKey rather than ModuleName in pruneCache The `pruneCache` function assumes that the list of `CachedInfo` all have unique `ModuleName`, this is not true: * In normal compilation, the same module name can appear for a file and it's boot file. * In multiple home unit compilation the same ModuleName can appear in different units The fix is to use a `NodeKey` as the actual key for the interfaces which includes `ModuleName`, `IsBoot` and `UnitId`. Fixes #22677 - - - - - 336b2b1c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Recompilation checking: Don't try to find artefacts for Interactive & hs-boot combo In interactive mode we don't produce any linkables for hs-boot files. So we also need to not going looking for them when we check to see if we have all the right objects needed for recompilation. Ticket #22669 - - - - - 6469fea7 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Don't write o-boot files in Interactive mode We should not be producing object files when in interactive mode but we still produced the dummy o-boot files. These never made it into a `Linkable` but then confused the recompilation checker. Fixes #22669 - - - - - 06cc0a95 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Improve driver diagnostic messages by including UnitId in message Currently the driver diagnostics don't give any indication about which unit they correspond to. For example `-Wmissing-home-modules` can fire multiple times for each different home unit and gives no indication about which unit it's actually reporting about. Perhaps a longer term fix is to generalise the providence information away from a SrcSpan so that these kind of whole project errors can be reported with an accurate provenance. For now we can just include the `UnitId` in the error message. Fixes #22678 - - - - - 4fe9eaff by Matthew Pickering at 2023-01-24T05:37:52-05:00 Key ModSummary cache by UnitId as well as FilePath Multiple units can refer to the same files without any problem. Just another assumption which needs to be updated when we may have multiple home units. However, there is the invariant that within each unit each file only maps to one module, so as long as we also key the cache by UnitId then we are all good. This led to some confusing behaviour in GHCi when reloading, multipleHomeUnits_shared distils the essence of what can go wrong. Fixes #22679 - - - - - ada29f5c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Finder: Look in current unit before looking in any home package dependencies In order to preserve existing behaviour it's important to look within the current component before consideirng a module might come from an external component. This already happened by accident in `downsweep`, (because roots are used to repopulated the cache) but in the `Finder` the logic was the wrong way around. Fixes #22680 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp -------------------------p - - - - - be701cc6 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Debug: Print full NodeKey when pretty printing ModuleGraphNode This is helpful when debugging multiple component issues. - - - - - 34d2d463 by Krzysztof Gogolewski at 2023-01-24T05:38:32-05:00 Fix Lint check for duplicate external names Lint was checking for duplicate external names by calling removeDups, which needs a comparison function that is passed to Data.List.sortBy. But the comparison was not a valid ordering - it returned LT if one of the names was not external. For example, the previous implementation won't find a duplicate in [M.x, y, M.x]. Instead, we filter out non-external names before looking for duplicates. - - - - - 1c050ed2 by Matthew Pickering at 2023-01-24T05:39:08-05:00 Add test for T22671 This was fixed by b13c6ea5 Closes #22671 - - - - - 05e6a2d9 by Tom Ellis at 2023-01-24T12:10:52-05:00 Clarify where `f` is defined - - - - - d151546e by Cheng Shao at 2023-01-24T12:11:29-05:00 CmmToC: fix CmmRegOff for 64-bit register on a 32-bit target We used to print the offset value to a platform word sized integer. This is incorrect when the offset is negative (e.g. output of cmm constant folding) and the register is 64-bit but on a 32-bit target, and may lead to incorrect runtime result (e.g. #22607). The fix is simple: just treat it as a proper MO_Add, with the correct width info inferred from the register itself. Metric Increase: T12707 T13379 T4801 T5321FD T5321Fun - - - - - 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 - - - - - 1bd32a35 by Sylvain Henry at 2023-01-26T12:34:21-05:00 Factorize hptModulesBelow Create and use moduleGraphModulesBelow in GHC.Unit.Module.Graph that doesn't need anything from the driver to be used. - - - - - 1262d3f8 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Store dehydrated data structures in CgModBreaks This fixes a tricky leak in GHCi where we were retaining old copies of HscEnvs when reloading. If not all modules were recompiled then these hydrated fields in break points would retain a reference to the old HscEnv which could double memory usage. Fixes #22530 - - - - - e27eb80c by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force more in NFData Name instance Doesn't force the lazy `OccName` field (#19619) which is already known as a really bad source of leaks. When we slam the hammer storing Names on disk (in interface files or the like), all this should be forced as otherwise a `Name` can easily retain an `Id` and hence the entire world. Fixes #22833 - - - - - 3d004d5a by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force OccName in tidyTopName This occname has just been derived from an `Id`, so need to force it promptly so we can release the Id back to the world. Another symptom of the bug caused by #19619 - - - - - f2a0fea0 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Strict fields in ModNodeKey (otherwise retains HomeModInfo) Towards #22530 - - - - - 5640cb1d by Sylvain Henry at 2023-01-26T12:35:36-05:00 Hadrian: fix doc generation Was missing dependencies on files generated by templates (e.g. ghc.cabal) - - - - - 3e827c3f by Richard Eisenberg at 2023-01-26T20:06:53-05:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. - - - - - b3ef5c89 by doyougnu at 2023-01-26T20:07:48-05:00 tryFillBuffer: strictify more speculative bangs - - - - - d0d7ba0f by Vladislav Zavialov at 2023-01-26T20:08:25-05:00 base: NoImplicitPrelude in Data.Void and Data.Kind This change removes an unnecessary dependency on Prelude from two modules in the base package. - - - - - fa1db923 by Matthew Pickering at 2023-01-26T20:09:00-05: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 - - - - - 807310a1 by Matthew Pickering at 2023-01-26T20:09:00-05:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. - - - - - c7116b10 by Ben Gamari at 2023-01-26T20:09:35-05:00 base: Make changelog proposal references more consistent Addresses #22773. - - - - - 6932cfc7 by Sylvain Henry at 2023-01-26T20:10:27-05:00 Fix spurious change from !9568 - - - - - e480fbc2 by Ben Gamari at 2023-01-27T05:01:24-05:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 - - - - - 2648c09c by Andrei Borzenkov at 2023-01-27T05:02:07-05:00 Replace errors from badOrigBinding with new one (#22839) Problem: in 02279a9c the type-level [] syntax was changed from a built-in name to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if a name is not built-in then it must have come from TH quotation, but this is not necessarily the case with []. The outdated assumption in badOrigBinding leads to incorrect error messages. This code: data [] Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []" Unfortunately, there is not enough information in RdrName to directly determine if the name was constructed via TH or by the parser, so this patch changes the error message instead. It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote into a new error TcRnBindingOfExistingName and changes its wording to avoid guessing the origin of the name. - - - - - 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 534b46b5 by Ben Gamari at 2023-02-13T14:15:55+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/nix/sources.json - .gitlab/darwin/toolchain.nix - + .gitlab/gen-ci.cabal - .gitlab/gen_ci.hs - + .gitlab/generate_job_metadata - .gitlab/generate_jobs - .gitlab/hello.hs - + .gitlab/hie.yaml - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md - + .gitlab/rel_eng/default.nix - + .gitlab/rel_eng/fetch-gitlab-artifacts/.gitignore - + .gitlab/rel_eng/fetch-gitlab-artifacts/README.mkd - + .gitlab/rel_eng/fetch-gitlab-artifacts/default.nix - + .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - + .gitlab/rel_eng/fetch-gitlab-artifacts/setup.py - + .gitlab/rel_eng/mk-ghcup-metadata/.gitignore - + .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - + .gitlab/rel_eng/mk-ghcup-metadata/default.nix - + .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - + .gitlab/rel_eng/mk-ghcup-metadata/setup.py - + .gitlab/rel_eng/nix/sources.json - + .gitlab/rel_eng/nix/sources.nix - + .gitlab/rel_eng/upload.sh - .gitlab/upload_ghc_libs.py → .gitlab/rel_eng/upload_ghc_libs.py - CODEOWNERS - INSTALL.md - boot The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0bc1cb4f5d8fabda32dd3ecde0ca646ed9e9e193...534b46b51175aa06d7db199316bd866298159a32 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0bc1cb4f5d8fabda32dd3ecde0ca646ed9e9e193...534b46b51175aa06d7db199316bd866298159a32 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 15:05:37 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 13 Feb 2023 10:05:37 -0500 Subject: [Git][ghc/ghc][wip/general-catgeory] unicode: Don't inline bitmap in generalCategory Message-ID: <63ea51c191020_26da84528141510fb@gitlab.mail> Matthew Pickering pushed to branch wip/general-catgeory at Glasgow Haskell Compiler / GHC Commits: c4f246af by Matthew Pickering at 2023-02-13T15:05:22+00:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 T18304 ------------------------- - - - - - 3 changed files: - libraries/base/GHC/Unicode/Internal/Char/UnicodeData/GeneralCategory.hs - libraries/base/changelog.md - libraries/base/tools/ucd2haskell/exe/Parser/Text.hs Changes: ===================================== libraries/base/GHC/Unicode/Internal/Char/UnicodeData/GeneralCategory.hs ===================================== The diff for this file was not included because it is too large. ===================================== libraries/base/changelog.md ===================================== @@ -4,6 +4,8 @@ * 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. + * Refactor `generalCategory` to stop very large literal string being inlined to call-sites. + ([CLC proposal #130](https://github.com/haskell/core-libraries-committee/issues/130)) ## 4.18.0.0 *TBA* * `Foreign.C.ConstPtr.ConstrPtr` was added to encode `const`-qualified ===================================== libraries/base/tools/ucd2haskell/exe/Parser/Text.hs ===================================== @@ -205,7 +205,11 @@ genEnumBitmap funcName def as = unlines <> show (length as) <> " then " <> show (fromEnum def) - <> " else lookupIntN bitmap# n" + <> " else lookup_bitmap n" + + , "{-# NOINLINE lookup_bitmap #-}" + , "lookup_bitmap :: Int -> Int" + , "lookup_bitmap n = lookupIntN bitmap# n" , " where" , " bitmap# = \"" <> enumMapToAddrLiteral as "\"#" ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c4f246afbe71d4e7a29963d0830455076cc9c353 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c4f246afbe71d4e7a29963d0830455076cc9c353 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 15:34:23 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Mon, 13 Feb 2023 10:34:23 -0500 Subject: [Git][ghc/ghc][wip/or-pats] Test fixes Message-ID: <63ea587fa1283_26da8424550e01912b9@gitlab.mail> David pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: 7689564d by David Knothe at 2023-02-13T16:34:18+01:00 Test fixes - - - - - 6 changed files: - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - testsuite/tests/parser/should_fail/Or1.hs - testsuite/tests/parser/should_fail/Or1.stderr - testsuite/tests/parser/should_fail/Or2.hs - testsuite/tests/parser/should_fail/Or2.stderr Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -3825,7 +3825,6 @@ varid :: { LocatedN RdrName } | 'forall' { sL1n $1 $! mkUnqual varName (fsLit "forall") } | 'family' { sL1n $1 $! mkUnqual varName (fsLit "family") } | 'role' { sL1n $1 $! mkUnqual varName (fsLit "role") } - | 'one' { sL1n $1 $! mkUnqual varName (fsLit "one") } -- If this changes relative to tyvarid, update 'checkRuleTyVarBndrNames' -- in GHC.Parser.PostProcess -- See Note [Parsing explicit foralls in Rules] @@ -3852,7 +3851,7 @@ varsym_no_minus :: { LocatedN RdrName } -- varsym not including '-' -- These special_ids are treated as keywords in various places, -- but as ordinary ids elsewhere. 'special_id' collects all these --- except 'unsafe', 'interruptible', 'forall', 'family', 'role', 'stock', 'one' +-- except 'unsafe', 'interruptible', 'forall', 'family', 'role', 'stock' -- and 'anyclass', whose treatment differs depending on context special_id :: { Located FastString } special_id @@ -3866,6 +3865,7 @@ special_id | 'ccall' { sL1 $1 (fsLit "ccall") } | 'capi' { sL1 $1 (fsLit "capi") } | 'prim' { sL1 $1 (fsLit "prim") } + | 'one' { sL1 $1 (fsLit "one") } | 'javascript' { sL1 $1 (fsLit "javascript") } -- See Note [%shift: special_id -> 'group'] | 'group' %shift { sL1 $1 (fsLit "group") } ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -999,7 +999,7 @@ reservedWordsFM = listToUFM $ ( "mdo", ITmdo Nothing, xbit RecursiveDoBit), -- See Note [Lexing type pseudo-keywords] ( "family", ITfamily, 0 ), - ( "one", ITone, xbit OrPatternsBit), + ( "one", ITone, 0), ( "role", ITrole, 0 ), ( "pattern", ITpattern, xbit PatternSynonymsBit), ( "static", ITstatic, xbit StaticPointersBit ), ===================================== testsuite/tests/parser/should_fail/Or1.hs ===================================== @@ -1,9 +1,6 @@ module Main where -main = g 3 && h 1 +main = print $ h 1 -h y = case y of - (one of 2, 3) -> True - -g x = case x of - one of 4, 5 -> False \ No newline at end of file +h one = case one of + (one of 2, 3) -> True \ No newline at end of file ===================================== testsuite/tests/parser/should_fail/Or1.stderr ===================================== @@ -2,5 +2,3 @@ Or1.hs:6:4: error: [GHC-29847] Illegal or-pattern: one of 2, 3 Suggested fix: Perhaps you intended to use OrPatterns - -Or1.hs:9:7: error: [GHC-58481] parse error on input ‘of’ ===================================== testsuite/tests/parser/should_fail/Or2.hs ===================================== @@ -1,6 +1,9 @@ -{-# LANGUAGE OrPatterns #-} +{-# LANGUAGE OrPatterns, PatternSynonyms #-} module Main where main = case 3 of - (one of 4) -> False \ No newline at end of file + (one of 4) -> False + +g x = case x of + one of 4, 5 -> False ===================================== testsuite/tests/parser/should_fail/Or2.stderr ===================================== @@ -1,3 +1,5 @@ Or2.hs:6:4: error: [GHC-96152] An or-pattern needs at least two alternatives: one of 4 + +Or2.hs:9:7: error: [GHC-58481] parse error on input ‘of’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7689564d58a89c35520139834bdb7056c1ddba7c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7689564d58a89c35520139834bdb7056c1ddba7c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 15:36:32 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 13 Feb 2023 10:36:32 -0500 Subject: [Git][ghc/ghc] Pushed new tag ghc-9.6.1-alpha3 Message-ID: <63ea5900b864a_26da84527ec19207f@gitlab.mail> Ben Gamari pushed new tag ghc-9.6.1-alpha3 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/ghc-9.6.1-alpha3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 16:55:28 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Mon, 13 Feb 2023 11:55:28 -0500 Subject: [Git][ghc/ghc][wip/or-pats] 17 commits: Update `Data.List.singleton` doc comment Message-ID: <63ea6b80d908b_26da8424550e021059f@gitlab.mail> David pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 7b40a6bf by David Knothe at 2023-02-13T17:55:04+01:00 Add Or Patterns (proposal 0522) - - - - - a9eea663 by David Knothe at 2023-02-13T17:55:05+01:00 Update submodule haddock & linting stuff - - - - - 5546a105 by David Knothe at 2023-02-13T17:55:05+01:00 Write user guide entry - - - - - c0298e4b by David Knothe at 2023-02-13T17:55:05+01:00 Add EPAs - - - - - 043d5665 by David Knothe at 2023-02-13T17:55:05+01:00 Update submodule haddock - - - - - b97476e9 by David Knothe at 2023-02-13T17:55:06+01:00 Add EPA test - - - - - 678dcdef by Sebastian Graf at 2023-02-13T17:55:06+01:00 Adjust the pattern-match checker for Or patterns Previously, any pattern match or guard could be desugared into a vector of elementary `PmGrd`s (called `GrdVec`) that must all match conjunctively. But with Or patterns, that is bound to change, quite drastically so: Or patterns imply disjunctive matching, and because they may occur nestedly inside other patterns, we need to widen our `GrdVec` type to accomodate both conjunctive/sequential as well as disjunctive/alternative composition. This leads to a rather modest generalisation of the guard tree formalism, yielding guard *directed acyclic graphs*. These DAGs are *series-parallel*, that is to say a *very* benign kind of DAG that is nearly a tree, and which can be defined easily as an inductive data type, `GrdDag`. Beyond adjustments to use the new graph constructors, the rest is just routine re-use of the existing `topToBottom` combinator in `GHC.HsToCore.Pmc.Check`. Nice! - - - - - 4d3a9027 by David Knothe at 2023-02-13T17:55:07+01:00 Minor things - - - - - 923b6dfe by David Knothe at 2023-02-13T17:55:07+01:00 Fix test errors - - - - - 5c5a93f5 by David Knothe at 2023-02-13T17:55:08+01:00 Test fixes - - - - - 30 changed files: - .gitlab/merge_request_templates/merge-request.md - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Types.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/Tc/Errors/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7689564d58a89c35520139834bdb7056c1ddba7c...5c5a93f59ab960b65d4b38af233d426309868af2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7689564d58a89c35520139834bdb7056c1ddba7c...5c5a93f59ab960b65d4b38af233d426309868af2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 17:19:21 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 13 Feb 2023 12:19:21 -0500 Subject: [Git][ghc/ghc][wip/T21909] 2 commits: Constraint simplification loop now depends on `ExpansionFuel` Message-ID: <63ea711937b8f_26da845286421903@gitlab.mail> Apoorv Ingle pushed to branch wip/T21909 at Glasgow Haskell Compiler / GHC Commits: a2833e65 by Apoorv Ingle at 2023-02-13T11:04:08-06:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Fixes #21909 Added Tests T21909, T21909b Added Note [SimplifyInfer and UndecidableSuperClasses] - - - - - 8b30116d by Apoorv Ingle at 2023-02-13T11:18:01-06:00 make expansion fuel a dynamic flag - - - - - 10 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings/Constants.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - docs/users_guide/expected-undocumented-flags.txt - + testsuite/tests/typecheck/should_compile/T21909.hs - + testsuite/tests/typecheck/should_compile/T21909b.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -517,6 +517,12 @@ data DynFlags = DynFlags { reductionDepth :: IntWithInf, -- ^ Typechecker maximum stack depth solverIterations :: IntWithInf, -- ^ Number of iterations in the constraints solver -- Typically only 1 is needed + givensFuel :: Int, -- ^ Number of layers of superclass expansion + -- Should be < solverIterations + wantedsFuel :: Int, -- ^ Number of layers of superclass expansion + -- Should be < givensFuel + qcsFuel :: Int, -- ^ Number of layers of superclass expansion + -- Should be < givensFuel homeUnitId_ :: UnitId, -- ^ Target home unit-id homeUnitInstanceOf_ :: Maybe UnitId, -- ^ Id of the unit to instantiate @@ -1148,6 +1154,9 @@ defaultDynFlags mySettings = mainFunIs = Nothing, reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH, solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS, + givensFuel = mAX_GIVENS_FUEL, + wantedsFuel = mAX_WANTEDS_FUEL, + qcsFuel = mAX_QC_FUEL, homeUnitId_ = mainUnitId, homeUnitInstanceOf_ = Nothing, @@ -2732,6 +2741,12 @@ dynamic_flags_deps = [ (intSuffix (\n d -> d { reductionDepth = treatZeroAsInf n })) , make_ord_flag defFlag "fconstraint-solver-iterations" (intSuffix (\n d -> d { solverIterations = treatZeroAsInf n })) + , make_ord_flag defFlag "fgivens-expansion-fuel" + (intSuffix (\n d -> d { givensFuel = n })) + , make_ord_flag defFlag "fwanteds-expansion-fuel" + (intSuffix (\n d -> d { wantedsFuel = n })) + , make_ord_flag defFlag "fqcs-expansion-fuel" + (intSuffix (\n d -> d { qcsFuel = n })) , (Deprecated, defFlag "fcontext-stack" (intSuffixM (\n d -> do { deprecate $ "use -freduction-depth=" ++ show n ++ " instead" ===================================== compiler/GHC/Settings/Constants.hs ===================================== @@ -30,6 +30,21 @@ mAX_REDUCTION_DEPTH = 200 mAX_SOLVER_ITERATIONS :: Int mAX_SOLVER_ITERATIONS = 4 +-- | In case of loopy quantified costraints constraints, +-- how many times should we allow superclass expansions +mAX_QC_FUEL :: Int +mAX_QC_FUEL = 3 + +-- | In case of loopy wanted constraints, +-- how many times should we allow superclass expansions +mAX_WANTEDS_FUEL :: Int +mAX_WANTEDS_FUEL = 1 + +-- | In case of loopy given constraints, +-- how many times should we allow superclass expansions +mAX_GIVENS_FUEL :: Int +mAX_GIVENS_FUEL = 3 + wORD64_SIZE :: Int wORD64_SIZE = 8 ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -2338,6 +2338,10 @@ maybe_simplify_again n limit unif_happened wc@(WC { wc_simple = simples }) do { new_given <- makeSuperClasses pending_given ; new_wanted <- makeSuperClasses pending_wanted ; solveSimpleGivens new_given -- Add the new Givens to the inert set + ; traceTcS "maybe_simplify_again" (vcat [ text "pending_given" <+> ppr pending_given + , text "new_given" <+> ppr new_given + , text "pending_wanted" <+> ppr pending_wanted + , text "new_wanted" <+> ppr new_wanted ]) ; simplify_loop n limit (not (null pending_given)) $ wc { wc_simple = simples1 `unionBags` listToBag new_wanted } } } -- (not (null pending_given)): see Note [Superclass iteration] @@ -2366,6 +2370,43 @@ superclasses. In that case we check whether the new Wanteds actually led to any new unifications, and iterate the implications only if so. -} +{- Note [SimplifyInfer with UndecidableSuperClasses] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In some cases while infering the type of a term well typed term, it is necessary to ensure +we limit the wanted superclass expansions. +Expanding them too many times will lead to the given constraint superclass expansion +not being able solve all the wanted constraints, by entering a perpetual loop and erroring out on +too many solver iterations. Expanding them too little will not give us a simplified type signature. + +Consider the program (T21909) + + class C [a] => C a where + foo :: a -> Int + + bar :: C a => a -> Int + bar x = foolocal x + where + foolocal x = foo x + +In the current implimentation +We infer the type of foolocal to be `(C a) => a -> Int` +and then simplify it to `(C a, C [[a]]) => a -> Int` + +This indeed is not simplification per say, but we are in UndecidableSuperclass case +so we cannot guarantee simplification of contraints. What we aim for is for the +the solver to not to loop unnecessarily generating more wanted constraints than +in can solve in `maybe_simplify_again`. + +If we did not limit the wanteds superclass expansion we would simplify the type signature of +foolocal as `(C a , C [[a]], C[[[[a]]]], C[[[[a]]]], C [[[[[[[[a]]]]]]]]) => a -> Int` +Definitely _worse_ than above type! + +The current limit the expansion of such recursive wanted constraints to 1 (mAX_WANTEDS_FUEL), +and limit the expansion of recursive given constraints to 3 (mAX_GIVENS_FUEL). + +-} + + solveNestedImplications :: Bag Implication -> TcS (Bag Implication) -- Precondition: the TcS inerts may contain unsolved simples which have ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -58,7 +58,7 @@ import Control.Monad import Data.Maybe ( isJust, isNothing ) import Data.List ( zip4 ) import GHC.Types.Basic - +import GHC.Driver.Session ( DynFlags, givensFuel, wantedsFuel, qcsFuel ) import qualified Data.Semigroup as S import Data.Bifunctor ( bimap ) @@ -127,14 +127,16 @@ canonicalize (CEqCan { cc_ev = ev canNC :: CtEvidence -> TcS (StopOrContinue Ct) canNC ev = case classifyPredType pred of - ClassPred cls tys -> do traceTcS "canEvNC:cls" (ppr cls <+> ppr tys) - canClassNC ev cls tys + ClassPred cls tys -> do dflags <- getDynFlags + traceTcS "canEvNC:cls" (ppr cls <+> ppr tys) + canClassNC dflags ev cls tys EqPred eq_rel ty1 ty2 -> do traceTcS "canEvNC:eq" (ppr ty1 $$ ppr ty2) canEqNC ev eq_rel ty1 ty2 IrredPred {} -> do traceTcS "canEvNC:irred" (ppr pred) canIrred ev - ForAllPred tvs th p -> do traceTcS "canEvNC:forall" (ppr pred) - canForAllNC ev tvs th p + ForAllPred tvs th p -> do dflags <- getDynFlags + traceTcS "canEvNC:forall" (ppr pred) + canForAllNC dflags ev tvs th p where pred = ctEvPred ev @@ -147,15 +149,16 @@ canNC ev = ************************************************************************ -} -canClassNC :: CtEvidence -> Class -> [Type] -> TcS (StopOrContinue Ct) +canClassNC :: DynFlags -> CtEvidence -> Class -> [Type] -> TcS (StopOrContinue Ct) -- "NC" means "non-canonical"; that is, we have got here -- from a NonCanonical constraint, not from a CDictCan -- Precondition: EvVar is class evidence -canClassNC ev cls tys +canClassNC dflags ev cls tys | isGiven ev -- See Note [Eagerly expand given superclasses] - = do { sc_cts <- mkStrictSuperClasses ev [] [] cls tys + = do { let gf = givensFuel dflags + ; sc_cts <- mkStrictSuperClasses gf ev [] [] cls tys ; emitWork sc_cts - ; canClass ev cls tys False } + ; canClass ev cls tys doNotExpand } | CtWanted { ctev_rewriters = rewriters } <- ev , Just ip_name <- isCallStackPred cls tys @@ -181,14 +184,16 @@ canClassNC ev cls tys (ctLocSpan loc) (ctEvExpr new_ev) ; solveCallStack ev ev_cs - ; canClass new_ev cls tys False -- No superclasses + ; canClass new_ev cls tys doNotExpand -- No superclasses } | otherwise - = canClass ev cls tys (has_scs cls) + = canClass ev cls tys fuel where - has_scs cls = not (null (classSCTheta cls)) + fuel | cls_has_scs = wantedsFuel dflags + | otherwise = doNotExpand + cls_has_scs = not (null (classSCTheta cls)) loc = ctEvLoc ev orig = ctLocOrigin loc pred = ctEvPred ev @@ -205,7 +210,7 @@ solveCallStack ev ev_cs = do canClass :: CtEvidence -> Class -> [Type] - -> Bool -- True <=> un-explored superclasses + -> ExpansionFuel -- n > 0 <=> un-explored superclasses -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence @@ -492,39 +497,40 @@ makeSuperClasses :: [Ct] -> TcS [Ct] -- class C [a] => D a -- makeSuperClasses (C x) will return (D x, C [x]) -- --- NB: the incoming constraints have had their cc_pend_sc flag already --- flipped to False, by isPendingScDict, so we are /obliged/ to at --- least produce the immediate superclasses +-- NB: the incoming constraints will be expanded only if the fuel is striclty > 0 +-- expansion will consume a unit of fuel makeSuperClasses cts = concatMapM go cts where - go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys }) - = mkStrictSuperClasses ev [] [] cls tys - go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev })) + go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys, cc_pend_sc = fuel }) + = assertPpr (fuel > 0) (ppr cls) $ -- fuel needs to be more than 0 always + mkStrictSuperClasses (consumeFuel fuel) ev [] [] cls tys + go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev, qci_pend_sc = fuel })) = assertPpr (isClassPred pred) (ppr pred) $ -- The cts should all have -- class pred heads - mkStrictSuperClasses ev tvs theta cls tys + assertPpr (fuel > 0) (ppr cls) $ -- fuel needs to be more than 0 always + mkStrictSuperClasses (consumeFuel fuel) ev tvs theta cls tys where (tvs, theta, cls, tys) = tcSplitDFunTy (ctEvPred ev) go ct = pprPanic "makeSuperClasses" (ppr ct) mkStrictSuperClasses - :: CtEvidence + :: ExpansionFuel -> CtEvidence -> [TyVar] -> ThetaType -- These two args are non-empty only when taking -- superclasses of a /quantified/ constraint -> Class -> [Type] -> TcS [Ct] -- Return constraints for the strict superclasses of -- ev :: forall as. theta => cls tys -mkStrictSuperClasses ev tvs theta cls tys - = mk_strict_superclasses (unitNameSet (className cls)) +mkStrictSuperClasses fuel ev tvs theta cls tys + = mk_strict_superclasses fuel (unitNameSet (className cls)) ev tvs theta cls tys -mk_strict_superclasses :: NameSet -> CtEvidence +mk_strict_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return the immediate superclasses of (cls tys); -- and expand their superclasses, provided none of them are in rec_clss -- nor are repeated -mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) +mk_strict_superclasses fuel rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) tvs theta cls tys = concatMapM do_one_given $ classSCSelIds cls @@ -542,7 +548,7 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) | otherwise = do { given_ev <- newGivenEvVar sc_loc $ mk_given_desc sel_id sc_pred - ; mk_superclasses rec_clss given_ev tvs theta sc_pred } + ; mk_superclasses fuel rec_clss given_ev tvs theta sc_pred } where sc_pred = classMethodInstTy sel_id tys @@ -603,7 +609,7 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) newly_blocked (InstSkol _ head_size) = isJust (this_size `ltPatersonSize` head_size) newly_blocked _ = False -mk_strict_superclasses rec_clss ev tvs theta cls tys +mk_strict_superclasses fuel rec_clss ev tvs theta cls tys | all noFreeVarsOfType tys = return [] -- Wanteds with no variables yield no superclass constraints. -- See Note [Improvement from Ground Wanteds] @@ -618,7 +624,7 @@ mk_strict_superclasses rec_clss ev tvs theta cls tys do_one sc_pred = do { traceTcS "mk_strict_superclasses Wanted" (ppr (mkClassPred cls tys) $$ ppr sc_pred) ; sc_ev <- newWantedNC loc (ctEvRewriters ev) sc_pred - ; mk_superclasses rec_clss sc_ev [] [] sc_pred } + ; mk_superclasses fuel rec_clss sc_ev [] [] sc_pred } {- Note [Improvement from Ground Wanteds] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -633,46 +639,49 @@ dependencies. See Note [Why adding superclasses can help] above. But no variables means no improvement; case closed. -} -mk_superclasses :: NameSet -> CtEvidence +mk_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> PredType -> TcS [Ct] -- Return this constraint, plus its superclasses, if any -mk_superclasses rec_clss ev tvs theta pred +mk_superclasses fuel rec_clss ev tvs theta pred | ClassPred cls tys <- classifyPredType pred - = mk_superclasses_of rec_clss ev tvs theta cls tys + = mk_superclasses_of fuel rec_clss ev tvs theta cls tys | otherwise -- Superclass is not a class predicate = return [mkNonCanonical ev] -mk_superclasses_of :: NameSet -> CtEvidence +mk_superclasses_of :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return this class constraint, -- and expand its superclasses -mk_superclasses_of rec_clss ev tvs theta cls tys +mk_superclasses_of fuel rec_clss ev tvs theta cls tys | loop_found = do { traceTcS "mk_superclasses_of: loop" (ppr cls <+> ppr tys) - ; return [this_ct] } -- cc_pend_sc of this_ct = True + ; return [this_ct] } -- cc_pend_sc of this_ct = fuel | otherwise = do { traceTcS "mk_superclasses_of" (vcat [ ppr cls <+> ppr tys , ppr (isCTupleClass cls) , ppr rec_clss ]) - ; sc_cts <- mk_strict_superclasses rec_clss' ev tvs theta cls tys + ; sc_cts <- mk_strict_superclasses fuel rec_clss' ev tvs theta cls tys ; return (this_ct : sc_cts) } - -- cc_pend_sc of this_ct = False + -- cc_pend_sc of this_ct = doNotExpand where cls_nm = className cls loop_found = not (isCTupleClass cls) && cls_nm `elemNameSet` rec_clss -- Tuples never contribute to recursion, and can be nested rec_clss' = rec_clss `extendNameSet` cls_nm + this_cc_pend | loop_found = fuel + | otherwise = 0 + this_ct | null tvs, null theta = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys - , cc_pend_sc = loop_found } + , cc_pend_sc = this_cc_pend } -- NB: If there is a loop, we cut off, so we have not -- added the superclasses, hence cc_pend_sc = True | otherwise = CQuantCan (QCI { qci_tvs = tvs, qci_pred = mkClassPred cls tys , qci_ev = ev - , qci_pend_sc = loop_found }) + , qci_pend_sc = this_cc_pend }) {- Note [Equality superclasses in quantified constraints] @@ -723,6 +732,7 @@ canIrred :: CtEvidence -> TcS (StopOrContinue Ct) -- Precondition: ty not a tuple and no other evidence form canIrred ev = do { let pred = ctEvPred ev + ; dflags <- getDynFlags ; traceTcS "can_pred" (text "IrredPred = " <+> ppr pred) ; (redn, rewriters) <- rewrite ev pred ; rewriteEvidence rewriters ev redn `andWhenContinue` \ new_ev -> @@ -731,7 +741,7 @@ canIrred ev -- Code is like the canNC, except -- that the IrredPred branch stops work ; case classifyPredType (ctEvPred new_ev) of - ClassPred cls tys -> canClassNC new_ev cls tys + ClassPred cls tys -> canClassNC dflags new_ev cls tys EqPred eq_rel ty1 ty2 -> -- IrredPreds have kind Constraint, so -- cannot become EqPreds pprPanic "canIrred: EqPred" @@ -740,7 +750,7 @@ canIrred ev -- should never leave a meta-var filled -- in with a polytype. This is #18987. do traceTcS "canEvNC:forall" (ppr pred) - canForAllNC ev tvs th p + canForAllNC dflags ev tvs th p IrredPred {} -> continueWith $ mkIrredCt IrredShapeReason new_ev } } @@ -822,24 +832,28 @@ type signature. -} -canForAllNC :: CtEvidence -> [TyVar] -> TcThetaType -> TcPredType +canForAllNC :: DynFlags -> CtEvidence -> [TyVar] -> TcThetaType -> TcPredType -> TcS (StopOrContinue Ct) -canForAllNC ev tvs theta pred +canForAllNC dflags ev tvs theta pred | isGiven ev -- See Note [Eagerly expand given superclasses] , Just (cls, tys) <- cls_pred_tys_maybe - = do { sc_cts <- mkStrictSuperClasses ev tvs theta cls tys + = do { let gf = givensFuel dflags + ; sc_cts <- mkStrictSuperClasses gf ev tvs theta cls tys ; emitWork sc_cts - ; canForAll ev False } + ; canForAll ev doNotExpand } | otherwise - = canForAll ev (isJust cls_pred_tys_maybe) + = do { let qcf = qcsFuel dflags + fuel | isJust cls_pred_tys_maybe = qcf + | otherwise = doNotExpand + ; canForAll ev fuel } where cls_pred_tys_maybe = getClassPredTys_maybe pred -canForAll :: CtEvidence -> Bool -> TcS (StopOrContinue Ct) +canForAll :: CtEvidence -> ExpansionFuel -> TcS (StopOrContinue Ct) -- We have a constraint (forall as. blah => C tys) -canForAll ev pend_sc +canForAll ev fuel = do { -- First rewrite it to apply the current substitution let pred = ctEvPred ev ; (redn, rewriters) <- rewrite ev pred @@ -849,14 +863,14 @@ canForAll ev pend_sc -- (It takes a lot less code to rewrite before decomposing.) ; case classifyPredType (ctEvPred new_ev) of ForAllPred tvs theta pred - -> solveForAll new_ev tvs theta pred pend_sc + -> solveForAll new_ev tvs theta pred fuel _ -> pprPanic "canForAll" (ppr new_ev) } } -solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> Bool +solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> ExpansionFuel -> TcS (StopOrContinue Ct) solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_loc = loc }) - tvs theta pred _pend_sc + tvs theta pred _fuel = -- See Note [Solving a Wanted forall-constraint] setLclEnv (ctLocEnv loc) $ -- This setLclEnv is important: the emitImplicationTcS uses that @@ -902,12 +916,12 @@ solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_lo _ -> pSizeType pred -- See Note [Solving a Given forall-constraint] -solveForAll ev@(CtGiven {}) tvs _theta pred pend_sc +solveForAll ev@(CtGiven {}) tvs _theta pred fuel = do { addInertForAll qci ; stopWith ev "Given forall-constraint" } where qci = QCI { qci_ev = ev, qci_tvs = tvs - , qci_pred = pred, qci_pend_sc = pend_sc } + , qci_pred = pred, qci_pend_sc = fuel } {- Note [Solving a Wanted forall-constraint] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -513,10 +513,13 @@ getInertGivens ; return (filter isGivenCt all_cts) } getPendingGivenScs :: TcS [Ct] --- Find all inert Given dictionaries, or quantified constraints, --- whose cc_pend_sc flag is True --- and that belong to the current level --- Set their cc_pend_sc flag to False in the inert set, and return that Ct +-- Find all inert Given dictionaries, or quantified constraints, such that +-- 1. cc_pend_sc flag has fuel strictly > 0 +-- 2. belongs to the current level +-- For each such dictionary: +-- * Return it (with unmodified cc_pend_sc) in sc_pending +-- * Modify the dict in the inert set to have cc_pend_sc = doNotExpand +-- to record that we have expanded superclasses for this dict getPendingGivenScs = do { lvl <- getTcLevel ; updRetInertCans (get_sc_pending lvl) } @@ -530,29 +533,33 @@ get_sc_pending this_lvl ic@(IC { inert_dicts = dicts, inert_insts = insts }) sc_pending = sc_pend_insts ++ sc_pend_dicts sc_pend_dicts = foldDicts get_pending dicts [] - dicts' = foldr add dicts sc_pend_dicts + dicts' = foldr exhaustAndAdd dicts sc_pend_dicts (sc_pend_insts, insts') = mapAccumL get_pending_inst [] insts - get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc = True - -- but flipping the flag + get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc > 0 get_pending dict dicts - | Just dict' <- pendingScDict_maybe dict + | isPendingScDict dict , belongs_to_this_level (ctEvidence dict) - = dict' : dicts + = dict : dicts | otherwise = dicts - add :: Ct -> DictMap Ct -> DictMap Ct - add ct@(CDictCan { cc_class = cls, cc_tyargs = tys }) dicts - = addDict dicts cls tys ct - add ct _ = pprPanic "getPendingScDicts" (ppr ct) + exhaustAndAdd :: Ct -> DictMap Ct -> DictMap Ct + exhaustAndAdd ct@(CDictCan { cc_class = cls, cc_tyargs = tys }) dicts + -- exhaust the fuel for this constraint before adding it as + -- we don't want to expand these constraints again + = addDict dicts cls tys (ct {cc_pend_sc = doNotExpand}) + exhaustAndAdd ct _ = pprPanic "getPendingScDicts" (ppr ct) get_pending_inst :: [Ct] -> QCInst -> ([Ct], QCInst) get_pending_inst cts qci@(QCI { qci_ev = ev }) | Just qci' <- pendingScInst_maybe qci , belongs_to_this_level ev - = (CQuantCan qci' : cts, qci') + = (CQuantCan qci : cts, qci') + -- qci' have their fuel exhausted + -- we don't want to expand these constraints again + -- qci is expanded | otherwise = (cts, qci) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -11,6 +11,7 @@ module GHC.Tc.Types.Constraint ( -- Canonical constraints Xi, Ct(..), Cts, + ExpansionFuel, doNotExpand, consumeFuel, emptyCts, andCts, andManyCts, pprCts, singleCt, listToCts, ctsElts, consCts, snocCts, extendCtsList, isEmptyCts, @@ -138,8 +139,6 @@ import Data.Word ( Word8 ) import Data.List ( intersperse ) - - {- ************************************************************************ * * @@ -191,6 +190,16 @@ type Xi = TcType type Cts = Bag Ct +-- | Says how many layers of superclasses can we expand. +-- see Note [SimplifyInfer with UndecidableSuperClasses] +type ExpansionFuel = Int + +doNotExpand :: ExpansionFuel -- Do not expand superclasses anymore +doNotExpand = 0 + +consumeFuel :: ExpansionFuel -> ExpansionFuel +consumeFuel fuel = fuel - 1 + data Ct -- Atomic canonical constraints = CDictCan { -- e.g. Num ty @@ -199,11 +208,11 @@ data Ct cc_class :: Class, cc_tyargs :: [Xi], -- cc_tyargs are rewritten w.r.t. inerts, so Xi - cc_pend_sc :: Bool + cc_pend_sc :: ExpansionFuel -- See Note [The superclass story] in GHC.Tc.Solver.Canonical - -- True <=> (a) cc_class has superclasses - -- (b) we have not (yet) added those - -- superclasses as Givens + -- See Note [SimplifyInfer with UndecidableSuperClasses] in GHC.Tc.Solver + -- n > 0 <=> (a) cc_class has superclasses + -- (b) we have not (yet) explored those superclasses } | CIrredCan { -- These stand for yet-unusable predicates @@ -273,8 +282,11 @@ data QCInst -- A much simplified version of ClsInst -- Always Given , qci_tvs :: [TcTyVar] -- The tvs , qci_pred :: TcPredType -- The ty - , qci_pend_sc :: Bool -- Same as cc_pend_sc flag in CDictCan - -- Invariant: True => qci_pred is a ClassPred + , qci_pend_sc :: ExpansionFuel -- Invariants: qci_pend_sc > 0 => qci_pred is a ClassPred + -- and the superclasses are unexplored + -- Same as cc_pend_sc flag in CDictCan + -- See Note [SimplifyInfer with UndecidableSuperClasses] + -- in GHC.Tc.Solver } instance Outputable QCInst where @@ -673,11 +685,11 @@ instance Outputable Ct where CEqCan {} -> text "CEqCan" CNonCanonical {} -> text "CNonCanonical" CDictCan { cc_pend_sc = psc } - | psc -> text "CDictCan(psc)" - | otherwise -> text "CDictCan" + | psc > 0 -> text "CDictCan" <> parens (text "psc" <+> ppr psc) + | otherwise -> text "CDictCan" CIrredCan { cc_reason = reason } -> text "CIrredCan" <> ppr reason - CQuantCan (QCI { qci_pend_sc = pend_sc }) - | pend_sc -> text "CQuantCan(psc)" + CQuantCan (QCI { qci_pend_sc = psc }) + | psc > 0 -> text "CQuantCan" <> parens (text "psc" <+> ppr psc) | otherwise -> text "CQuantCan" ----------------------------------- @@ -893,23 +905,24 @@ isUserTypeError pred = case getUserTypeErrorMsg pred of _ -> False isPendingScDict :: Ct -> Bool -isPendingScDict (CDictCan { cc_pend_sc = psc }) = psc --- Says whether this is a CDictCan with cc_pend_sc is True; +isPendingScDict (CDictCan { cc_pend_sc = psc }) = psc > 0 +-- Says whether this is a CDictCan with cc_pend_sc has positive fuel; -- i.e. pending un-expanded superclasses isPendingScDict _ = False pendingScDict_maybe :: Ct -> Maybe Ct --- Says whether this is a CDictCan with cc_pend_sc is True, --- AND if so flips the flag -pendingScDict_maybe ct@(CDictCan { cc_pend_sc = True }) - = Just (ct { cc_pend_sc = False }) +-- Says whether this is a CDictCan with cc_pend_sc has fuel left, +-- AND if so exhausts the fuel so that they are not expanded again +pendingScDict_maybe ct@(CDictCan { cc_pend_sc = n }) + | n > 0 = Just (ct { cc_pend_sc = doNotExpand }) + | otherwise = Nothing pendingScDict_maybe _ = Nothing pendingScInst_maybe :: QCInst -> Maybe QCInst -- Same as isPendingScDict, but for QCInsts -pendingScInst_maybe qci@(QCI { qci_pend_sc = True }) - = Just (qci { qci_pend_sc = False }) -pendingScInst_maybe _ = Nothing +pendingScInst_maybe qci@(QCI { qci_pend_sc = n }) + | n > 0 = Just (qci { qci_pend_sc = doNotExpand }) + | otherwise = Nothing superClassesMightHelp :: WantedConstraints -> Bool -- ^ True if taking superclasses of givens, or of wanteds (to perhaps @@ -928,11 +941,12 @@ superClassesMightHelp (WC { wc_simple = simples, wc_impl = implics }) is_ip _ = False getPendingWantedScs :: Cts -> ([Ct], Cts) +-- in the return values [Ct] has original fuel while Cts has fuel exhausted getPendingWantedScs simples = mapAccumBagL get [] simples where - get acc ct | Just ct' <- pendingScDict_maybe ct - = (ct':acc, ct') + get acc ct | Just ct_exhausted <- pendingScDict_maybe ct + = (ct:acc, ct_exhausted) | otherwise = (acc, ct) ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -33,6 +33,9 @@ -fbang-patterns -fbuilding-cabal-package -fconstraint-solver-iterations +-fgivens-expansion-fuel +-fwanteds-expansion-fuel +-fqcs-expansion-fuel -fcontext-stack -fcross-module-specialize -fdiagnostics-color=always ===================================== testsuite/tests/typecheck/should_compile/T21909.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +module T21909 where + +import Data.Kind + +class (Monad m, MyMonad (Inner m)) => MyMonad m where + type Inner m :: Type -> Type + foo :: m Int + +works :: MyMonad m => m String +works = show <$> ((+ 1) <$> foo) + +fails :: MyMonad m => m String +fails = show <$> fooPlusOne + where + fooPlusOne = (+ 1) <$> foo + +alsoFails :: MyMonad m => m String +alsoFails = + let fooPlusOne = (+ 1) <$> foo + in show <$> fooPlusOne ===================================== testsuite/tests/typecheck/should_compile/T21909b.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableSuperClasses, FunctionalDependencies, MultiParamTypeClasses, GADTs #-} + +module T21909b where + +class C [a] => C a where + foo :: a -> Int + +bar :: C a => a -> Int +bar x = foolocal x + where + foolocal a = foo a ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -857,3 +857,5 @@ test('T22647', normal, compile, ['']) test('T19577', normal, compile, ['']) test('T22383', normal, compile, ['']) test('T21501', normal, compile, ['']) +test('T21909', normal, compile, ['']) +test('T21909b', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b8c266eb17100cd908c65f3a39213ec1c5e06f24...8b30116d32dc64e5cf88f20129994975ea028b8a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b8c266eb17100cd908c65f3a39213ec1c5e06f24...8b30116d32dc64e5cf88f20129994975ea028b8a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 17:51:32 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 13 Feb 2023 12:51:32 -0500 Subject: [Git][ghc/ghc][master] 2 commits: Refresh profiling docs Message-ID: <63ea78a421e5f_26da8449bc6a82431c3@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 2 changed files: - + docs/users_guide/images/eventlog_profile.png - docs/users_guide/profiling.rst Changes: ===================================== docs/users_guide/images/eventlog_profile.png ===================================== Binary files /dev/null and b/docs/users_guide/images/eventlog_profile.png differ ===================================== docs/users_guide/profiling.rst ===================================== @@ -10,17 +10,13 @@ Profiling GHC comes with a time and space profiling system, so that you can answer questions like "why is my program so slow?", or "why is my program using -so much memory?". +so much memory?". We'll start by describing how to do time profiling. -Profiling a program is a three-step process: +Time profiling a program is a three-step process: 1. Re-compile your program for profiling with the :ghc-flag:`-prof` option, and probably one of the options for adding automatic annotations: - :ghc-flag:`-fprof-auto` is the most common [1]_. - - If you are using external packages with :command:`cabal`, you may need to - reinstall these packages with profiling support; typically this is - done with ``cabal install -p package --reinstall``. + :ghc-flag:`-fprof-late` is the recommended option. 2. Having compiled the program for profiling, you now need to run it to generate the profile. For example, a simple time profile can be @@ -37,6 +33,9 @@ Profiling a program is a three-step process: 3. Examine the generated profiling information, use the information to optimise your program, and repeat as necessary. +The time profiler measures the CPU time taken by the Haskell code in your application. +In particular time taken by safe foreign calls is not tracked by the profiler (see :ref:`prof-foreign-calls`). + .. _cost-centres: Cost centres and cost-centre stacks @@ -197,7 +196,10 @@ Inserting cost centres by hand Cost centres are just program annotations. When you say ``-fprof-auto`` to the compiler, it automatically inserts a cost centre annotation around every binding not marked INLINE in your program, but you are -entirely free to add cost centre annotations yourself. +entirely free to add cost centre annotations yourself. Be careful adding too many +cost-centre annotations as the optimiser is careful to not move them around or +remove them, which can severly affect how your program is optimised and hence the +runtime performance! The syntax of a cost centre annotation for expressions is :: @@ -311,6 +313,39 @@ and become CAFs. You will probably need to consult the Core .. index:: single: -fprof-cafs +.. _prof-foreign-calls: + +Profiling and foreign calls +--------------------------- + +Simply put, the profiler includes time spent in unsafe foreign +calls but ignores time taken in safe foreign calls. For example, time spent blocked on IO +operations (e.g. ``getLine``) is not accounted for in the profile as ``getLine`` is implemented +using a safe foreign call. + +The profiler estimates CPU time, for Haskell threads within the program only. +In particular, time "taken" by the program in blocking safe foreign calls +is not accounted for in time profiles. The runtime has the notion of a virtual +processor which is known as a "capability". Haskell threads are run on capabilities, +and the profiler samples the capabilities in order to determine what is being +executed at a certain time. When a safe foreign call is executed, it's run outside +the context of a capability; hence the sampling does not account for the time +taken. Whilst the safe call is executed, other +Haskell threads are free to run on the capability, and their cost will be attributed +to the profiler. When the safe call is finished, the blocked, descheduled thread can +be resumed and rescheduled. + +However, the time taken by blocking on unsafe foreign calls is accounted for in the profile. +This happens because unsafe foreign calls are executed by the same capability +their calling Haskell thread is running on. Therefore, an unsafe foreign call will +block the entire capability whilst it is running, and any time the capability is +sampled the "cost" of the foreign call will be attributed to the calling cost-centre stack. + +However, do note that you are not supposed to use unsafe foreign calls for any +operations which do block! Do not be tempted to replace your safe foreign calls +with unsafe calls just so they appear in the profile. This prevents GC from +happening until the foreign call returns, which can be catastrophic for performance. + .. _prof-compiler-options: Compiler options for profiling @@ -356,7 +391,9 @@ Automatically placing cost-centres ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ GHC has a number of flags for automatically inserting cost-centres into the -compiled program. +compiled program. Use these options carefully because inserting too many cost-centres +in the wrong places will mean the optimiser will be less effective and the runtime behaviour +of your profiled program will be different to that of the unprofiled one. .. ghc-flag:: -fprof-callers=⟨name⟩ :shortdesc: Auto-add ``SCC``\\ s to all call-sites of the named function. @@ -618,8 +655,10 @@ enclosed between ``+RTS ... -RTS`` as usual): JSON profile format ~~~~~~~~~~~~~~~~~~~ -When invoked with the :rts-flag:`-pj` flag the runtime will emit the cost-centre -profile in a machine-readable JSON format. The top-level object of this format +profile in a machine-readable JSON format. The JSON file can be directly loaded +into `speedscope.app `_ to interactively view the profile. + +The top-level object of this format has the following properties, ``program`` (string) @@ -758,8 +797,12 @@ For instance, a simple profile might look like this, } } +Eventlog profile format +~~~~~~~~~~~~~~~~~~~~~~~ - +In addition to the ``.prof`` and ``.json`` formats the cost centre definitions +and samples are also emitted to the :ref:`eventlog `. The format +of the events is specified in the :ref:`eventlog encodings ` section. .. _prof-heap: @@ -774,18 +817,35 @@ program holds on to more memory at run-time that it needs to. Space leaks lead to slower execution due to heavy garbage collector activity, and may even cause the program to run out of memory altogether. +Heap profiling differs from time profiling in the fact that is not always +necessary to use the profiling runtime to generate a heap profile. There +are two heap profiling modes (:rts-flag:`-hT` and :rts-flag:`-hi` [1]_) which are always +available. + To generate a heap profile from your program: -1. Compile the program for profiling (:ref:`prof-compiler-options`). +1. Assuming you need the profiling runtime, compile the program for profiling (:ref:`prof-compiler-options`). 2. Run it with one of the heap profiling options described below (eg. - :rts-flag:`-hc` for a basic producer profile). This generates the file - :file:`{prog}.hp`. + :rts-flag:`-hc` for a basic producer profile) and enable the eventlog using :rts-flag:`-l <-l ⟨flags⟩>`. - If the :ref:`event log ` is enabled (with the :rts-flag:`-l ⟨flags⟩` - runtime system flag) heap samples will additionally be emitted to the GHC + Heap samples will be emitted to the GHC event log (see :ref:`heap-profiler-events` for details about event format). +3. Render the heap profile using `eventlog2html `_. + This produces an HTML file which contains the visualised profile. + +4. Open the rendered interactive profile in your web browser. + +For example, here is a heap profile produced of using eventlog profiling on GHC +compiling the Cabal library. You can read a lot more about eventlog2html on the website. + +.. image:: images/eventlog_profile.* + +Note that there is the legacy :file:`{prog}.hp` format which has been deprecated +in favour of eventlog based profiling. In order to render the legacy format, the +steps are as follows. + 3. Run :command:`hp2ps` to produce a Postscript file, :file:`{prog}.ps`. The :command:`hp2ps` utility is described in detail in :ref:`hp2ps`. @@ -797,10 +857,6 @@ from GHC's ``nofib`` benchmark suite, .. image:: images/prof_scc.* -You might also want to take a look at -`hp2any `__, a more advanced -suite of tools (not distributed with GHC) for displaying heap profiles. - Note that there might be a big difference between the OS reported memory usage of your program and the amount of live data as reported by heap profiling. The reasons for the difference are explained in :ref:`hints-os-memory`. @@ -817,20 +873,14 @@ following RTS options select which break-down to use: .. rts-flag:: -hT - Breaks down the graph by heap closure type. + Breaks down the graph by heap closure type. This does not require the profiling + runtime. .. rts-flag:: -hc - -h *Requires* :ghc-flag:`-prof`. Breaks down the graph by the cost-centre stack which produced the data. - .. note:: The meaning of the shortened :rts-flag:`-h` is dependent on whether - your program was compiled for profiling. When compiled for profiling, - :rts-flag:`-h` is equivalent to :rts-flag:`-hc`, but otherwise is - equivalent to :rts-flag:`-hT` (see :ref:`rts-profiling`). The :rts-flag:`-h` - is deprecated and will be removed in a future release. - .. rts-flag:: -hm *Requires* :ghc-flag:`-prof`. Break down the live heap by the module @@ -863,7 +913,7 @@ following RTS options select which break-down to use: Break down the graph by the address of the info table of a closure. For this to produce useful output the program must have been compiled with - :ghc-flag:`-finfo-table-map`. + :ghc-flag:`-finfo-table-map` but it does not require the profiling runtime. .. rts-flag:: -l :noindex: @@ -1041,6 +1091,14 @@ This trick isn't foolproof, because there might be other ``B`` closures in the heap which aren't the retainers we are interested in, but we've found this to be a useful technique in most cases. +Precise Retainer Analysis +~~~~~~~~~~~~~~~~~~~~~~~~~ + +If you want to precisely answer questions about why a certain type of closure is +retained then it is worthwhile using `ghc-debug `_ which +has a terminal interface which can be used to easily answer queries such as, what is retaining +a certain closure. + .. _biography-prof: Biographical Profiling @@ -1120,6 +1178,9 @@ reasons for this: allocated by foreign libraries, and data allocated by the RTS), and ``mmap()``\'d memory are not counted in the heap profile. +For more discussion about understanding how understanding process residency see +:ref:`hints-os-memory`. + .. _hp2ps: ``hp2ps`` -- Rendering heap profiles to PostScript @@ -1242,123 +1303,6 @@ The flags are: Print out usage information. -.. _manipulating-hp: - -Manipulating the ``hp`` file -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -(Notes kindly offered by Jan-Willem Maessen.) - -The ``FOO.hp`` file produced when you ask for the heap profile of a -program ``FOO`` is a text file with a particularly simple structure. -Here's a representative example, with much of the actual data omitted: - -.. code-block:: none - - JOB "FOO -hC" - DATE "Thu Dec 26 18:17 2002" - SAMPLE_UNIT "seconds" - VALUE_UNIT "bytes" - BEGIN_SAMPLE 0.00 - END_SAMPLE 0.00 - BEGIN_SAMPLE 15.07 - ... sample data ... - END_SAMPLE 15.07 - BEGIN_SAMPLE 30.23 - ... sample data ... - END_SAMPLE 30.23 - ... etc. - BEGIN_SAMPLE 11695.47 - END_SAMPLE 11695.47 - -The first four lines (``JOB``, ``DATE``, ``SAMPLE_UNIT``, -``VALUE_UNIT``) form a header. Each block of lines starting with -``BEGIN_SAMPLE`` and ending with ``END_SAMPLE`` forms a single sample -(you can think of this as a vertical slice of your heap profile). The -hp2ps utility should accept any input with a properly-formatted header -followed by a series of *complete* samples. - -Zooming in on regions of your profile -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -You can look at particular regions of your profile simply by loading a -copy of the ``.hp`` file into a text editor and deleting the unwanted -samples. The resulting ``.hp`` file can be run through ``hp2ps`` and -viewed or printed. - -Viewing the heap profile of a running program -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -The ``.hp`` file is generated incrementally as your program runs. In -principle, running :command:`hp2ps` on the incomplete file should produce a -snapshot of your program's heap usage. However, the last sample in the -file may be incomplete, causing :command:`hp2ps` to fail. If you are using a -machine with UNIX utilities installed, it's not too hard to work around -this problem (though the resulting command line looks rather Byzantine): - -.. code-block:: sh - - head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \ - | hp2ps > FOO.ps - -The command ``fgrep -n END_SAMPLE FOO.hp`` finds the end of every -complete sample in ``FOO.hp``, and labels each sample with its ending -line number. We then select the line number of the last complete sample -using :command:`tail` and :command:`cut`. This is used as a parameter to :command:`head`; the -result is as if we deleted the final incomplete sample from :file:`FOO.hp`. -This results in a properly-formatted .hp file which we feed directly to -:command:`hp2ps`. - -Viewing a heap profile in real time -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -The :command:`gv` and :command:`ghostview` programs have a "watch file" option -can be used to view an up-to-date heap profile of your program as it runs. -Simply generate an incremental heap profile as described in the previous -section. Run :command:`gv` on your profile: - -.. code-block:: sh - - gv -watch -orientation=seascape FOO.ps - -If you forget the ``-watch`` flag you can still select "Watch file" from -the "State" menu. Now each time you generate a new profile ``FOO.ps`` -the view will update automatically. - -This can all be encapsulated in a little script: - -.. code-block:: sh - - #!/bin/sh - head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \ - | hp2ps > FOO.ps - gv -watch -orientation=seascape FOO.ps & - while [ 1 ] ; do - sleep 10 # We generate a new profile every 10 seconds. - head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \ - | hp2ps > FOO.ps - done - -Occasionally :command:`gv` will choke as it tries to read an incomplete copy of -:file:`FOO.ps` (because :command:`hp2ps` is still running as an update occurs). A -slightly more complicated script works around this problem, by using the -fact that sending a SIGHUP to gv will cause it to re-read its input -file: - -.. code-block:: sh - - #!/bin/sh - head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \ - | hp2ps > FOO.ps - gv FOO.ps & - gvpsnum=$! - while [ 1 ] ; do - sleep 10 - head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \ - | hp2ps > FOO.ps - kill -HUP $gvpsnum - done - .. _prof-threaded: Profiling Parallel and Concurrent Programs @@ -1968,10 +1912,9 @@ Notes about ticky profiling in some columns. For this reason using an eventlog-based approach should be prefered if possible. - .. [1] - :ghc-flag:`-fprof-auto` was known as ``-auto-all`` prior to - GHC 7.4.1. + :rts-flag:`-hi` profiling is avaible with the normal runtime but you will need to + compile with :ghc-flag:`-finfo-table-map` to interpret the results. .. [2] Note that this policy has changed slightly in GHC 7.4.1 relative to View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/133516af8426d775fa0dc75c787edd56299ee6cf...da208b9aa03eaeec34528a7815d4d3451c106e18 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/133516af8426d775fa0dc75c787edd56299ee6cf...da208b9aa03eaeec34528a7815d4d3451c106e18 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 17:52:09 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 13 Feb 2023 12:52:09 -0500 Subject: [Git][ghc/ghc][master] Document that -fproc-alignment was introduced only in GHC 8.6 Message-ID: <63ea78c923815_26da8449bc6bc24879@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 1 changed file: - docs/users_guide/debugging.rst Changes: ===================================== docs/users_guide/debugging.rst ===================================== @@ -1046,6 +1046,8 @@ Checking for consistency :shortdesc: Align functions at given boundary. :type: dynamic + :since: 8.6.1 + Align functions to multiples of the given value. Only valid values are powers of two. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/081640f1e0b5a9def306f3e13c1825fef5403c95 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/081640f1e0b5a9def306f3e13c1825fef5403c95 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 18:16:22 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 13 Feb 2023 13:16:22 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T22965 Message-ID: <63ea7e765d3d6_26da8449bc6a82565f6@gitlab.mail> Ben Gamari pushed new branch wip/T22965 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22965 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 18:16:48 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 13 Feb 2023 13:16:48 -0500 Subject: [Git][ghc/ghc][wip/T22965] 8 commits: Update `Data.List.singleton` doc comment Message-ID: <63ea7e90cf0b1_26da8448900b82567cb@gitlab.mail> Ben Gamari pushed to branch wip/T22965 at Glasgow Haskell Compiler / GHC Commits: d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 01661e4e by Ben Gamari at 2023-02-13T13:16:35-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 22 changed files: - .gitlab/merge_request_templates/merge-request.md - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Unit/Module/ModIface.hs - libraries/base/Data/OldList.hs - libraries/base/tests/all.T - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - libraries/template-haskell/changelog.md - rts/Capability.h - testsuite/driver/testlib.py - + testsuite/tests/simplCore/should_compile/T22761.hs - + testsuite/tests/simplCore/should_compile/T22761a.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== .gitlab/merge_request_templates/merge-request.md ===================================== @@ -5,18 +5,19 @@ expectations. Also please answer the following question in your MR description:* **Where is the key part of this patch? That is, what should reviewers look at first?** -Please take a few moments to verify that your commits fulfill the following: +Please take a few moments to address the following points: - * [ ] are either individually buildable or squashed - * [ ] have commit messages which describe *what they do* - (referring to [Notes][notes] and tickets using `#NNNN` syntax when - appropriate) + * [ ] if your MR may break existing programs (e.g. touches `base` or causes the + compiler to reject programs), please describe the expected breakage and add + the ~"user facing" label. This will run ghc/head.hackage> to characterise + the effect of your change on Hackage. + * [ ] ensure that your commits are either individually buildable or squashed + * [ ] ensure that your commit messages describe *what they do* + (referring to tickets using `#NNNN` syntax when appropriate) * [ ] have added source comments describing your change. For larger changes you likely should add a [Note][notes] and cross-reference it from the relevant places. - * [ ] add a [testcase to the testsuite](https://gitlab.haskell.org/ghc/ghc/wikis/building/running-tests/adding). - * [ ] if your MR affects library interfaces (e.g. changes `base`) or affects whether GHC will accept user-written code, please add - the ~"user facing" label. + * [ ] add a [testcase to the testsuite][adding test]. * [ ] updates the users guide if applicable * [ ] mentions new features in the release notes for the next release @@ -29,3 +30,4 @@ no one has offerred review in a few days then please leave a comment mentioning @triagers. [notes]: https://gitlab.haskell.org/ghc/ghc/wikis/commentary/coding-style#comments-in-the-source-code +[adding test]: https://gitlab.haskell.org/ghc/ghc/wikis/building/running-tests/adding ===================================== compiler/GHC/Core.hs ===================================== @@ -1300,16 +1300,19 @@ data Unfolding df_args :: [CoreExpr] -- Args of the data con: types, superclasses and methods, } -- in positional order - | CoreUnfolding { -- An unfolding for an Id with no pragma, - -- or perhaps a NOINLINE pragma - -- (For NOINLINE, the phase, if any, is in the - -- InlinePragInfo for this Id.) - uf_tmpl :: CoreExpr, -- Template; occurrence info is correct - uf_src :: UnfoldingSource, -- Where the unfolding came from - uf_is_top :: Bool, -- True <=> top level binding - uf_cache :: UnfoldingCache, -- Cache of flags computable from the expr - -- See Note [Tying the 'CoreUnfolding' knot] - uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template. + | CoreUnfolding { -- An unfolding for an Id with no pragma, + -- or perhaps a NOINLINE pragma + -- (For NOINLINE, the phase, if any, is in the + -- InlinePragInfo for this Id.) + uf_tmpl :: CoreExpr, -- The unfolding itself (aka "template") + -- Always occ-analysed; + -- See Note [OccInfo in unfoldings and rules] + + uf_src :: UnfoldingSource, -- Where the unfolding came from + uf_is_top :: Bool, -- True <=> top level binding + uf_cache :: UnfoldingCache, -- Cache of flags computable from the expr + -- See Note [Tying the 'CoreUnfolding' knot] + uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template. } -- ^ An unfolding with redundant cached information. Parameters: -- @@ -1637,14 +1640,37 @@ change was requested by Roman, but it seems to make sense. Note [OccInfo in unfoldings and rules] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In unfoldings and rules, we guarantee that the template is occ-analysed, -so that the occurrence info on the binders is correct. This is important, -because the Simplifier does not re-analyse the template when using it. If -the occurrence info is wrong - - We may get more simplifier iterations than necessary, because - once-occ info isn't there - - More seriously, we may get an infinite loop if there's a Rec - without a loop breaker marked +In unfoldings and rules, we guarantee that the template is occ-analysed, so +that the occurrence info on the binders is correct. That way, when the +Simplifier inlines an unfolding, it doesn't need to occ-analysis it first. +(The Simplifier is designed to simplify occ-analysed expressions.) + +Given this decision it's vital that we do *always* do it. + +* If we don't, we may get more simplifier iterations than necessary, + because once-occ info isn't there + +* More seriously, we may get an infinite loop if there's a Rec without a + loop breaker marked. + +* Or we may get code that mentions variables not in scope: #22761 + e.g. Suppose we have a stable unfolding : \y. let z = p+1 in 3 + Then the pre-simplifier occ-anal will occ-anal the unfolding + (redundantly perhaps, but we need its free vars); this will not report + the use of `p`; so p's binding will be discarded, and yet `p` is still + mentioned. + + Better to occ-anal the unfolding at birth, which will drop the + z-binding as dead code. (Remember, it's the occurrence analyser that + drops dead code.) + +* Another example is #8892: + \x -> letrec { f = ...g...; g* = f } in body + where g* is (for some strange reason) the loop breaker. If we don't + occ-anal it when reading it in, we won't mark g as a loop breaker, and we + may inline g entirely in body, dropping its binding, and leaving the + occurrence in f out of scope. This happened in #8892, where the unfolding + in question was a DFun unfolding. ************************************************************************ ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -3088,8 +3088,15 @@ etaExpandToJoinPointRule join_arity rule@(Rule { ru_bndrs = bndrs, ru_rhs = rhs | need_args < 0 = pprPanic "etaExpandToJoinPointRule" (ppr join_arity $$ ppr rule) | otherwise - = rule { ru_bndrs = bndrs ++ new_bndrs, ru_args = args ++ new_args - , ru_rhs = new_rhs } + = rule { ru_bndrs = bndrs ++ new_bndrs + , ru_args = args ++ new_args + , ru_rhs = new_rhs } + -- new_rhs really ought to be occ-analysed (see GHC.Core Note + -- [OccInfo in unfoldings and rules]), but it makes a module loop to + -- do so; it doesn't happen often; and it doesn't really matter if + -- the outer binders have bogus occurrence info; and new_rhs won't + -- have dead code if rhs didn't. + where need_args = join_arity - length args (new_bndrs, new_rhs) = etaBodyForJoinPoint need_args rhs ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -2165,6 +2165,17 @@ So we have a fast-path that keeps the old tree if the occ_bs_env is empty. This just saves a bit of allocation and reconstruction; not a big deal. +This fast path exposes a tricky cornder, though (#22761). Supose we have + Unfolding = \x. let y = foo in x+1 +which includes a dead binding for `y`. In occAnalUnfolding we occ-anal +the unfolding and produce /no/ occurrences of `foo` (since `y` is +dead). But if we discard the occ-analysed syntax tree (which we do on +our fast path), and use the old one, we still /have/ an occurrence of +`foo` -- and that can lead to out-of-scope variables (#22761). + +Solution: always keep occ-analysed trees in unfoldings and rules, so they +have no dead code. See Note [OccInfo in unfoldings and rules] in GHC.Core. + Note [Cascading inlines] ~~~~~~~~~~~~~~~~~~~~~~~~ By default we use an rhsCtxt for the RHS of a binding. This tells the ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -1065,7 +1065,7 @@ subst_id_bndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) -- See Note [Bangs in the Simplifier] !id1 = uniqAway in_scope old_id !id2 = substIdType env id1 - !id3 = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding + !id3 = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding -- and fragile OccInfo !new_id = adjust_type id3 ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -319,14 +319,14 @@ simplLazyBind :: SimplEnv -> TopLevelFlag -> RecFlag -> InId -> OutId -- Binder, both pre-and post simpl -- Not a JoinId - -- The OutId has IdInfo, except arity, unfolding + -- The OutId has IdInfo (notably RULES), + -- except arity, unfolding -- Ids only, no TyVars -> InExpr -> SimplEnv -- The RHS and its environment -> SimplM (SimplFloats, SimplEnv) -- Precondition: the OutId is already in the InScopeSet of the incoming 'env' -- Precondition: not a JoinId -- Precondition: rhs obeys the let-can-float invariant --- NOT used for JoinIds simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se = assert (isId bndr ) assertPpr (not (isJoinId bndr)) (ppr bndr) $ @@ -398,48 +398,45 @@ simplJoinBind env is_rec cont old_bndr new_bndr rhs rhs_se ; completeBind env (BC_Join is_rec cont) old_bndr new_bndr rhs' } -------------------------- -simplNonRecX :: SimplEnv +simplAuxBind :: SimplEnv -> InId -- Old binder; not a JoinId -> OutExpr -- Simplified RHS -> SimplM (SimplFloats, SimplEnv) --- A specialised variant of simplNonRec used when the RHS is already --- simplified, notably in knownCon. It uses case-binding where necessary. +-- A specialised variant of completeBindX used to construct non-recursive +-- auxiliary bindings, notably in knownCon. +-- +-- The binder comes from a case expression (case binder or alternative) +-- and so does not have rules, inline pragmas etc. -- -- Precondition: rhs satisfies the let-can-float invariant -simplNonRecX env bndr new_rhs - | assertPpr (not (isJoinId bndr)) (ppr bndr) $ +simplAuxBind env bndr new_rhs + | assertPpr (isId bndr && not (isJoinId bndr)) (ppr bndr) $ isDeadBinder bndr -- Not uncommon; e.g. case (a,b) of c { (p,q) -> p } = return (emptyFloats env, env) -- Here c is dead, and we avoid - -- creating the binding c = (a,b) - - | Coercion co <- new_rhs - = return (emptyFloats env, extendCvSubst env bndr co) + -- creating the binding c = (a,b) + -- The cases would be inlined unconditionally by completeBind: + -- but it seems not uncommon, and avoids faff to do it here + -- This is safe because it's only used for auxiliary bindings, which + -- have no NOLINE pragmas, nor RULEs | exprIsTrivial new_rhs -- Short-cut for let x = y in ... - -- This case would ultimately land in postInlineUnconditionally - -- but it seems not uncommon, and avoids a lot of faff to do it here - = return (emptyFloats env - , extendIdSubst env bndr (DoneEx new_rhs Nothing)) + = return ( emptyFloats env + , case new_rhs of + Coercion co -> extendCvSubst env bndr co + _ -> extendIdSubst env bndr (DoneEx new_rhs Nothing) ) | otherwise - = do { (env1, new_bndr) <- simplBinder env bndr - ; let is_strict = isStrictId new_bndr - -- isStrictId: use new_bndr because the InId bndr might not have - -- a fixed runtime representation, which isStrictId doesn't expect - -- c.f. Note [Dark corner with representation polymorphism] - - ; (rhs_floats, rhs1) <- prepareBinding env NotTopLevel NonRecursive is_strict - new_bndr (emptyFloats env) new_rhs - -- NB: it makes a surprisingly big difference (5% in compiler allocation - -- in T9630) to pass 'env' rather than 'env1'. It's fine to pass 'env', - -- because this is simplNonRecX, so bndr is not in scope in the RHS. - - ; (bind_float, env2) <- completeBind (env1 `setInScopeFromF` rhs_floats) - (BC_Let NotTopLevel NonRecursive) + = do { -- ANF-ise the RHS + let !occ_fs = getOccFS bndr + ; (anf_floats, rhs1) <- prepareRhs env NotTopLevel occ_fs new_rhs + ; unless (isEmptyLetFloats anf_floats) (tick LetFloatFromLet) + ; let rhs_floats = emptyFloats env `addLetFloats` anf_floats + + -- Simplify the binder and complete the binding + ; (env1, new_bndr) <- simplBinder (env `setInScopeFromF` rhs_floats) bndr + ; (bind_float, env2) <- completeBind env1 (BC_Let NotTopLevel NonRecursive) bndr new_bndr rhs1 - -- Must pass env1 to completeBind in case simplBinder had to clone, - -- and extended the substitution with [bndr :-> new_bndr] ; return (rhs_floats `addFloats` bind_float, env2) } @@ -761,49 +758,54 @@ prepareRhs :: HasDebugCallStack -- x = Just a -- See Note [prepareRhs] prepareRhs env top_lvl occ rhs0 - = do { (_is_exp, floats, rhs1) <- go 0 rhs0 - ; return (floats, rhs1) } + | is_expandable = anfise rhs0 + | otherwise = return (emptyLetFloats, rhs0) where - go :: Int -> OutExpr -> SimplM (Bool, LetFloats, OutExpr) - go n_val_args (Cast rhs co) - = do { (is_exp, floats, rhs') <- go n_val_args rhs - ; return (is_exp, floats, Cast rhs' co) } - go n_val_args (App fun (Type ty)) - = do { (is_exp, floats, rhs') <- go n_val_args fun - ; return (is_exp, floats, App rhs' (Type ty)) } - go n_val_args (App fun arg) - = do { (is_exp, floats1, fun') <- go (n_val_args+1) fun - ; if is_exp - then do { (floats2, arg') <- makeTrivial env top_lvl topDmd occ arg - ; return (True, floats1 `addLetFlts` floats2, App fun' arg') } - else return (False, emptyLetFloats, App fun arg) - } - go n_val_args (Var fun) - = return (is_exp, emptyLetFloats, Var fun) - where - is_exp = isExpandableApp fun n_val_args -- The fun a constructor or PAP - -- See Note [CONLIKE pragma] in GHC.Types.Basic - -- The definition of is_exp should match that in - -- 'GHC.Core.Opt.OccurAnal.occAnalApp' - - go n_val_args (Tick t rhs) + -- We can' use exprIsExpandable because the WHOLE POINT is that + -- we want to treat (K ) as expandable, because we are just + -- about "anfise" the expression. exprIsExpandable would + -- just say no! + is_expandable = go rhs0 0 + where + go (Var fun) n_val_args = isExpandableApp fun n_val_args + go (App fun arg) n_val_args + | isTypeArg arg = go fun n_val_args + | otherwise = go fun (n_val_args + 1) + go (Cast rhs _) n_val_args = go rhs n_val_args + go (Tick _ rhs) n_val_args = go rhs n_val_args + go _ _ = False + + anfise :: OutExpr -> SimplM (LetFloats, OutExpr) + anfise (Cast rhs co) + = do { (floats, rhs') <- anfise rhs + ; return (floats, Cast rhs' co) } + anfise (App fun (Type ty)) + = do { (floats, rhs') <- anfise fun + ; return (floats, App rhs' (Type ty)) } + anfise (App fun arg) + = do { (floats1, fun') <- anfise fun + ; (floats2, arg') <- makeTrivial env top_lvl topDmd occ arg + ; return (floats1 `addLetFlts` floats2, App fun' arg') } + anfise (Var fun) + = return (emptyLetFloats, Var fun) + + anfise (Tick t rhs) -- We want to be able to float bindings past this -- tick. Non-scoping ticks don't care. | tickishScoped t == NoScope - = do { (is_exp, floats, rhs') <- go n_val_args rhs - ; return (is_exp, floats, Tick t rhs') } + = do { (floats, rhs') <- anfise rhs + ; return (floats, Tick t rhs') } -- On the other hand, for scoping ticks we need to be able to -- copy them on the floats, which in turn is only allowed if -- we can obtain non-counting ticks. | (not (tickishCounts t) || tickishCanSplit t) - = do { (is_exp, floats, rhs') <- go n_val_args rhs + = do { (floats, rhs') <- anfise rhs ; let tickIt (id, expr) = (id, mkTick (mkNoCount t) expr) floats' = mapLetFloats floats tickIt - ; return (is_exp, floats', Tick t rhs') } + ; return (floats', Tick t rhs') } - go _ other - = return (False, emptyLetFloats, other) + anfise other = return (emptyLetFloats, other) makeTrivialArg :: HasDebugCallStack => SimplEnv -> ArgSpec -> SimplM (LetFloats, ArgSpec) makeTrivialArg env arg@(ValArg { as_arg = e, as_dmd = dmd }) @@ -1244,7 +1246,7 @@ simplExprF1 env (Let (NonRec bndr rhs) body) cont | otherwise = {-#SCC "simplNonRecE" #-} - simplNonRecE env False bndr (rhs, env) body cont + simplNonRecE env FromLet bndr (rhs, env) body cont {- Note [Avoiding space leaks in OutType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1505,8 +1507,9 @@ rebuild env expr cont StrictArg { sc_fun = fun, sc_cont = cont, sc_fun_ty = fun_ty } -> rebuildCall env (addValArgTo fun expr fun_ty ) cont - StrictBind { sc_bndr = b, sc_body = body, sc_env = se, sc_cont = cont } - -> completeBindX (se `setInScopeFromE` env) b expr body cont + StrictBind { sc_bndr = b, sc_body = body, sc_env = se + , sc_cont = cont, sc_from = from_what } + -> completeBindX (se `setInScopeFromE` env) from_what b expr body cont ApplyToTy { sc_arg_ty = ty, sc_cont = cont} -> rebuild env (App expr (Type ty)) cont @@ -1518,25 +1521,48 @@ rebuild env expr cont ; rebuild env (App expr arg') cont } completeBindX :: SimplEnv + -> FromWhat -> InId -> OutExpr -- Bind this Id to this (simplified) expression -- (the let-can-float invariant may not be satisfied) - -> InExpr -- In this lambda + -> InExpr -- In this body -> SimplCont -- Consumed by this continuation -> SimplM (SimplFloats, OutExpr) -completeBindX env bndr rhs body cont - | needsCaseBinding (idType bndr) rhs -- Enforcing the let-can-float-invariant - = do { (env1, bndr1) <- simplNonRecBndr env bndr - ; (floats, expr') <- simplLam env1 body cont +completeBindX env from_what bndr rhs body cont + | FromBeta arg_ty <- from_what + , needsCaseBinding arg_ty rhs -- Enforcing the let-can-float-invariant + = do { (env1, bndr1) <- simplNonRecBndr env bndr -- Lambda binders don't have rules + ; (floats, expr') <- simplNonRecBody env1 from_what body cont -- Do not float floats past the Case binder below ; let expr'' = wrapFloats floats expr' - ; let case_expr = Case rhs bndr1 (contResultType cont) [Alt DEFAULT [] expr''] + case_expr = Case rhs bndr1 (contResultType cont) [Alt DEFAULT [] expr''] ; return (emptyFloats env, case_expr) } - | otherwise - = do { (floats1, env') <- simplNonRecX env bndr rhs - ; (floats2, expr') <- simplLam env' body cont - ; return (floats1 `addFloats` floats2, expr') } + | otherwise -- Make a let-binding + = do { (env1, bndr1) <- simplNonRecBndr env bndr + ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) + + ; let is_strict = isStrictId bndr2 + -- isStrictId: use simplified binder because the InId bndr might not have + -- a fixed runtime representation, which isStrictId doesn't expect + -- c.f. Note [Dark corner with representation polymorphism] + + ; (rhs_floats, rhs1) <- prepareBinding env NotTopLevel NonRecursive is_strict + bndr2 (emptyFloats env) rhs + -- NB: it makes a surprisingly big difference (5% in compiler allocation + -- in T9630) to pass 'env' rather than 'env1'. It's fine to pass 'env', + -- because this is simplNonRecX, so bndr is not in scope in the RHS. + + ; (bind_float, env2) <- completeBind (env2 `setInScopeFromF` rhs_floats) + (BC_Let NotTopLevel NonRecursive) + bndr bndr2 rhs1 + -- Must pass env1 to completeBind in case simplBinder had to clone, + -- and extended the substitution with [bndr :-> new_bndr] + + -- Simplify the body + ; (body_floats, body') <- simplNonRecBody env2 from_what body cont + ; let all_floats = rhs_floats `addFloats` bind_float `addFloats` body_floats + ; return ( all_floats, body' ) } {- ************************************************************************ @@ -1674,6 +1700,14 @@ simplArg env dup_flag fun_ty arg_env arg ************************************************************************ -} +simplNonRecBody :: SimplEnv -> FromWhat + -> InExpr -> SimplCont + -> SimplM (SimplFloats, OutExpr) +simplNonRecBody env from_what body cont + = case from_what of + FromLet -> simplExprF env body cont + FromBeta {} -> simplLam env body cont + simplLam :: SimplEnv -> InExpr -> SimplCont -> SimplM (SimplFloats, OutExpr) @@ -1690,15 +1724,24 @@ simpl_lam env bndr body (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = cont }) -- Value beta-reduction simpl_lam env bndr body (ApplyToVal { sc_arg = arg, sc_env = arg_se - , sc_cont = cont, sc_dup = dup }) - | isSimplified dup -- Don't re-simplify if we've simplified it once - -- See Note [Avoiding exponential behaviour] + , sc_cont = cont, sc_dup = dup + , sc_hole_ty = fun_ty}) = do { tick (BetaReduction bndr) - ; completeBindX env bndr arg body cont } + ; let arg_ty = funArgTy fun_ty + ; if | isSimplified dup -- Don't re-simplify if we've simplified it once + -- Including don't preInlineUnconditionally + -- See Note [Avoiding exponential behaviour] + -> completeBindX env (FromBeta arg_ty) bndr arg body cont + + | Just env' <- preInlineUnconditionally env NotTopLevel bndr arg arg_se + , not (needsCaseBinding arg_ty arg) + -- Ok to test arg::InExpr in needsCaseBinding because + -- exprOkForSpeculation is stable under simplification + -> do { tick (PreInlineUnconditionally bndr) + ; simplLam env' body cont } - | otherwise -- See Note [Avoiding exponential behaviour] - = do { tick (BetaReduction bndr) - ; simplNonRecE env True bndr (arg, arg_se) body cont } + | otherwise + -> simplNonRecE env (FromBeta arg_ty) bndr (arg, arg_se) body cont } -- Discard a non-counting tick on a lambda. This may change the -- cost attribution slightly (moving the allocation of the @@ -1730,8 +1773,7 @@ simplLamBndrs env bndrs = mapAccumLM simplLamBndr env bndrs ------------------ simplNonRecE :: SimplEnv - -> Bool -- True <=> from a lambda - -- False <=> from a let + -> FromWhat -> InId -- The binder, always an Id -- Never a join point -> (InExpr, SimplEnv) -- Rhs of binding (or arg of lambda) @@ -1740,56 +1782,48 @@ simplNonRecE :: SimplEnv -> SimplM (SimplFloats, OutExpr) -- simplNonRecE is used for --- * non-top-level non-recursive non-join-point lets in expressions --- * beta reduction +-- * from=FromLet: a non-top-level non-recursive non-join-point let-expression +-- * from=FromBeta: a binding arising from a beta reduction -- --- simplNonRec env b (rhs, rhs_se) body k +-- simplNonRecE env b (rhs, rhs_se) body k -- = let env in -- cont< let b = rhs_se(rhs) in body > -- -- It deals with strict bindings, via the StrictBind continuation, -- which may abort the whole process. -- --- from_lam=False => the RHS satisfies the let-can-float invariant +-- from_what=FromLet => the RHS satisfies the let-can-float invariant -- Otherwise it may or may not satisfy it. -simplNonRecE env from_lam bndr (rhs, rhs_se) body cont - = assert (isId bndr && not (isJoinId bndr) ) $ - do { (env1, bndr1) <- simplNonRecBndr env bndr - ; let needs_case_binding = needsCaseBinding (idType bndr1) rhs - -- See Note [Dark corner with representation polymorphism] - -- If from_lam=False then needs_case_binding is False, - -- because the binding started as a let, which must - -- satisfy let-can-float - - ; if | from_lam && not needs_case_binding - -- If not from_lam we are coming from a (NonRec bndr rhs) binding - -- and preInlineUnconditionally has been done already; - -- no need to repeat it. But for lambdas we must be careful about - -- preInlineUndonditionally: consider (\(x:Int#). 3) (error "urk") - -- We must not drop the (error "urk"). - , Just env' <- preInlineUnconditionally env NotTopLevel bndr rhs rhs_se - -> do { tick (PreInlineUnconditionally bndr) - ; -- pprTrace "preInlineUncond" (ppr bndr <+> ppr rhs) $ - simplLam env' body cont } - - -- Deal with strict bindings - | isStrictId bndr1 && seCaseCase env - || from_lam && needs_case_binding - -- The important bit here is needs_case_binds; but no need to - -- test it if from_lam is False because then needs_case_binding is False too - -- NB: either way, the RHS may or may not satisfy let-can-float - -- but that's ok for StrictBind. - -> simplExprF (rhs_se `setInScopeFromE` env) rhs - (StrictBind { sc_bndr = bndr, sc_body = body - , sc_env = env, sc_cont = cont, sc_dup = NoDup }) - - -- Deal with lazy bindings - | otherwise - -> do { (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) - ; (floats1, env3) <- simplLazyBind env2 NotTopLevel NonRecursive bndr bndr2 rhs rhs_se - ; (floats2, expr') <- simplLam env3 body cont - ; return (floats1 `addFloats` floats2, expr') } } +simplNonRecE env from_what bndr (rhs, rhs_se) body cont + | assert (isId bndr && not (isJoinId bndr) ) $ + is_strict_bind + = -- Evaluate RHS strictly + simplExprF (rhs_se `setInScopeFromE` env) rhs + (StrictBind { sc_bndr = bndr, sc_body = body, sc_from = from_what + , sc_env = env, sc_cont = cont, sc_dup = NoDup }) + + | otherwise -- Evaluate RHS lazily + = do { (env1, bndr1) <- simplNonRecBndr env bndr + ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive) + ; (floats1, env3) <- simplLazyBind env2 NotTopLevel NonRecursive + bndr bndr2 rhs rhs_se + ; (floats2, expr') <- simplNonRecBody env3 from_what body cont + ; return (floats1 `addFloats` floats2, expr') } + + where + is_strict_bind = case from_what of + FromBeta arg_ty | isUnliftedType arg_ty -> True + -- If we are coming from a beta-reduction (FromBeta) we must + -- establish the let-can-float invariant, so go via StrictBind + -- If not, the invariant holds already, and it's optional. + -- Using arg_ty: see Note [Dark corner with representation polymorphism] + -- e.g (\r \(a::TYPE r) \(x::a). blah) @LiftedRep @Int arg + -- When we come to `x=arg` we myst choose lazy/strict correctly + -- It's wrong to err in either directly + + _ -> seCaseCase env && isStrUsedDmd (idDemandInfo bndr) + ------------------ simplRecE :: SimplEnv @@ -1835,7 +1869,7 @@ Note [Avoiding exponential behaviour] One way in which we can get exponential behaviour is if we simplify a big expression, and then re-simplify it -- and then this happens in a deeply-nested way. So we must be jolly careful about re-simplifying -an expression. That is why simplNonRecX does not try +an expression (#13379). That is why simplNonRecX does not try preInlineUnconditionally (unlike simplNonRecE). Example: @@ -2618,15 +2652,10 @@ Is this inefficient? Not really: we are about to walk over the result of the rule firing to simplify it, so occurrence analysis is at most a constant factor. -Possible improvement: occ-anal the rules when putting them in the -database; and in the simplifier just occ-anal the OutExpr arguments. -But that's more complicated and the rule RHS is usually tiny; so I'm -just doing the simple thing. - -Historical note: previously we did occ-anal the rules in Rule.hs, -but failed to occ-anal the OutExpr arguments, which led to the -nasty performance problem described above. - +Note, however, that the rule RHS is /already/ occ-analysed; see +Note [OccInfo in unfoldings and rules] in GHC.Core. There is something +unsatisfactory about doing it twice; but the rule RHS is usually very +small, and this is simple. Note [Optimising tagToEnum#] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2930,7 +2959,7 @@ rebuildCase env scrut case_bndr alts cont where simple_rhs env wfloats case_bndr_rhs bs rhs = assert (null bs) $ - do { (floats1, env') <- simplNonRecX env case_bndr case_bndr_rhs + do { (floats1, env') <- simplAuxBind env case_bndr case_bndr_rhs -- scrut is a constructor application, -- hence satisfies let-can-float invariant ; (floats2, expr') <- simplExprF env' rhs cont @@ -2997,7 +3026,7 @@ rebuildCase env scrut case_bndr alts@[Alt _ bndrs rhs] cont | all_dead_bndrs , doCaseToLet scrut case_bndr = do { tick (CaseElim case_bndr) - ; (floats1, env') <- simplNonRecX env case_bndr scrut + ; (floats1, env') <- simplAuxBind env case_bndr scrut ; (floats2, expr') <- simplExprF env' rhs cont ; return (floats1 `addFloats` floats2, expr') } @@ -3483,12 +3512,11 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont bind_args env' (b:bs') (arg : args) = assert (isId b) $ do { let b' = zap_occ b - -- Note that the binder might be "dead", because it doesn't - -- occur in the RHS; and simplNonRecX may therefore discard - -- it via postInlineUnconditionally. + -- zap_occ: the binder might be "dead", because it doesn't + -- occur in the RHS; and simplAuxBind may therefore discard it. -- Nevertheless we must keep it if the case-binder is alive, -- because it may be used in the con_app. See Note [knownCon occ info] - ; (floats1, env2) <- simplNonRecX env' b' arg -- arg satisfies let-can-float invariant + ; (floats1, env2) <- simplAuxBind env' b' arg -- arg satisfies let-can-float invariant ; (floats2, env3) <- bind_args env2 bs' args ; return (floats1 `addFloats` floats2, env3) } @@ -3514,7 +3542,7 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont ; let con_app = Var (dataConWorkId dc) `mkTyApps` dc_ty_args `mkApps` dc_args - ; simplNonRecX env bndr con_app } + ; simplAuxBind env bndr con_app } ------------------- missingAlt :: SimplEnv -> Id -> [InAlt] -> SimplCont @@ -3621,15 +3649,15 @@ mkDupableContWithDmds env dmds (TickIt t cont) ; return (floats, TickIt t cont') } mkDupableContWithDmds env _ - (StrictBind { sc_bndr = bndr, sc_body = body + (StrictBind { sc_bndr = bndr, sc_body = body, sc_from = from_what , sc_env = se, sc_cont = cont}) -- See Note [Duplicating StrictBind] -- K[ let x = <> in b ] --> join j x = K[ b ] -- j <> = do { let sb_env = se `setInScopeFromE` env ; (sb_env1, bndr') <- simplBinder sb_env bndr - ; (floats1, join_inner) <- simplLam sb_env1 body cont - -- No need to use mkDupableCont before simplLam; we + ; (floats1, join_inner) <- simplNonRecBody sb_env1 from_what body cont + -- No need to use mkDupableCont before simplNonRecBody; we -- use cont once here, and then share the result if necessary ; let join_body = wrapFloats floats1 join_inner @@ -3757,6 +3785,7 @@ mkDupableStrictBind env arg_bndr join_rhs res_ty , StrictBind { sc_bndr = arg_bndr , sc_body = join_rhs , sc_env = zapSubstEnv env + , sc_from = FromLet -- See Note [StaticEnv invariant] in GHC.Core.Opt.Simplify.Utils , sc_dup = OkToDup , sc_cont = mkBoringStop res_ty } ) @@ -4430,7 +4459,9 @@ simplRules env mb_new_id rules bind_cxt ; return (rule { ru_bndrs = bndrs' , ru_fn = fn_name' , ru_args = args' - , ru_rhs = rhs' }) } + , ru_rhs = occurAnalyseExpr rhs' }) } + -- Remember to occ-analyse, to drop dead code. + -- See Note [OccInfo in unfoldings and rules] in GHC.Core {- Note [Simplifying the RHS of a RULE] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -21,7 +21,7 @@ module GHC.Core.Opt.Simplify.Utils ( BindContext(..), bindContextLevel, -- The continuation type - SimplCont(..), DupFlag(..), StaticEnv, + SimplCont(..), DupFlag(..), FromWhat(..), StaticEnv, isSimplified, contIsStop, contIsDupable, contResultType, contHoleType, contHoleScaling, contIsTrivial, contArgs, contIsRhs, @@ -192,6 +192,7 @@ data SimplCont -- or, equivalently, = K[ (\x.b) e ] { sc_dup :: DupFlag -- See Note [DupFlag invariants] , sc_bndr :: InId + , sc_from :: FromWhat , sc_body :: InExpr , sc_env :: StaticEnv -- See Note [StaticEnv invariant] , sc_cont :: SimplCont } @@ -213,6 +214,8 @@ data SimplCont type StaticEnv = SimplEnv -- Just the static part is relevant +data FromWhat = FromLet | FromBeta OutType + -- See Note [DupFlag invariants] data DupFlag = NoDup -- Unsimplified, might be big | Simplified -- Simplified ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -63,6 +63,7 @@ import GHC.Core.Tidy ( tidyRules ) import GHC.Core.Map.Expr ( eqCoreExpr ) import GHC.Core.Opt.Arity( etaExpandToJoinPointRule ) import GHC.Core.Make ( mkCoreLams ) +import GHC.Core.Opt.OccurAnal( occurAnalyseExpr ) import GHC.Tc.Utils.TcType ( tcSplitTyConApp_maybe ) import GHC.Builtin.Types ( anyTypeOfKind ) @@ -189,13 +190,18 @@ mkRule :: Module -> Bool -> Bool -> RuleName -> Activation -- ^ Used to make 'CoreRule' for an 'Id' defined in the module being -- compiled. See also 'GHC.Core.CoreRule' mkRule this_mod is_auto is_local name act fn bndrs args rhs - = Rule { ru_name = name, ru_fn = fn, ru_act = act, - ru_bndrs = bndrs, ru_args = args, - ru_rhs = rhs, - ru_rough = roughTopNames args, - ru_origin = this_mod, - ru_orphan = orph, - ru_auto = is_auto, ru_local = is_local } + = Rule { ru_name = name + , ru_act = act + , ru_fn = fn + , ru_bndrs = bndrs + , ru_args = args + , ru_rhs = occurAnalyseExpr rhs + -- See Note [OccInfo in unfoldings and rules] + , ru_rough = roughTopNames args + , ru_origin = this_mod + , ru_orphan = orph + , ru_auto = is_auto + , ru_local = is_local } where -- Compute orphanhood. See Note [Orphans] in GHC.Core.InstEnv -- A rule is an orphan only if none of the variables ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -513,8 +513,8 @@ bindNonRec bndr rhs body -- | Tests whether we have to use a @case@ rather than @let@ binding for this -- expression as per the invariants of 'CoreExpr': see "GHC.Core#let_can_float_invariant" needsCaseBinding :: Type -> CoreExpr -> Bool -needsCaseBinding ty rhs = - mightBeUnliftedType ty && not (exprOkForSpeculation rhs) +needsCaseBinding ty rhs + = mightBeUnliftedType ty && not (exprOkForSpeculation rhs) -- Make a case expression instead of a let -- These can arise either from the desugarer, -- or from beta reductions: (\x.e) (x +# y) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4939,6 +4939,7 @@ needSourceNotes dflags = debugLevel dflags > 0 -- LinkerInfo contains any extra options needed by the system linker. data LinkerInfo = GnuLD [Option] + | Mold [Option] | GnuGold [Option] | LlvmLLD [Option] | DarwinLD [Option] ===================================== compiler/GHC/SysTools/Info.hs ===================================== @@ -70,6 +70,7 @@ The flag is only needed on ELF systems. On Windows (PE) and Mac OS X neededLinkArgs :: LinkerInfo -> [Option] neededLinkArgs (GnuLD o) = o +neededLinkArgs (Mold o) = o neededLinkArgs (GnuGold o) = o neededLinkArgs (LlvmLLD o) = o neededLinkArgs (DarwinLD o) = o @@ -106,6 +107,10 @@ getLinkerInfo' logger dflags = do -- see Note [ELF needed shared libs] "-Wl,--no-as-needed"]) + | any ("mold" `isPrefixOf`) stdo = + return (Mold $ map Option [ --see Note [ELF needed shared libs] + "-Wl,--no-as-needed"]) + | any ("GNU gold" `isPrefixOf`) stdo = -- GNU gold only needs --no-as-needed. #10110. -- ELF specific flag, see Note [ELF needed shared libs] ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -723,12 +723,14 @@ setIdCprSig id sig = modifyIdInfo (\info -> setCprSigInfo info sig) id zapIdDmdSig :: Id -> Id zapIdDmdSig id = modifyIdInfo (`setDmdSigInfo` nopSig) id --- | This predicate says whether the 'Id' has a strict demand placed on it or --- has a type such that it can always be evaluated strictly (i.e an --- unlifted type, as of GHC 7.6). We need to --- check separately whether the 'Id' has a so-called \"strict type\" because if --- the demand for the given @id@ hasn't been computed yet but @id@ has a strict --- type, we still want @isStrictId id@ to be @True at . +-- | `isStrictId` says whether either +-- (a) the 'Id' has a strict demand placed on it or +-- (b) definitely has a \"strict type\", such that it can always be +-- evaluated strictly (i.e an unlifted type) +-- We need to check (b) as well as (a), because when the demand for the +-- given `id` hasn't been computed yet but `id` has a strict +-- type, we still want `isStrictId id` to be `True`. +-- Returns False if the type is levity polymorphic; False is always safe. isStrictId :: Id -> Bool isStrictId id | assertPpr (isId id) (text "isStrictId: not an id: " <+> ppr id) $ ===================================== compiler/GHC/Unit/Module/ModIface.hs ===================================== @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE NamedFieldPuns #-} module GHC.Unit.Module.ModIface ( ModIface @@ -549,20 +550,58 @@ emptyIfaceHashCache _occ = Nothing -- Take care, this instance only forces to the degree necessary to -- avoid major space leaks. -instance (NFData (IfaceBackendExts (phase :: ModIfacePhase)), NFData (IfaceDeclExts (phase :: ModIfacePhase))) => NFData (ModIface_ phase) where - rnf (ModIface f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 - f13 f14 f15 f16 f17 f18 f19 f20 f21 f22 f23 f24) = - rnf f1 `seq` rnf f2 `seq` f3 `seq` f4 `seq` f5 `seq` f6 `seq` rnf f7 `seq` f8 `seq` - f9 `seq` rnf f10 `seq` rnf f11 `seq` rnf f12 `seq` f13 `seq` rnf f14 `seq` rnf f15 `seq` rnf f16 `seq` - rnf f17 `seq` f18 `seq` rnf f19 `seq` rnf f20 `seq` rnf f21 `seq` f22 `seq` f23 `seq` rnf f24 +instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase)) + , NFData (IfaceDeclExts (phase :: ModIfacePhase)) + ) => NFData (ModIface_ phase) where + rnf (ModIface{ mi_module, mi_sig_of, mi_hsc_src, mi_deps, mi_usages + , mi_exports, mi_used_th, mi_fixities, mi_warns, mi_anns + , mi_decls, mi_extra_decls, mi_globals, mi_insts + , mi_fam_insts, mi_rules, mi_hpc, mi_trust, mi_trust_pkg + , mi_complete_matches, mi_docs, mi_final_exts + , mi_ext_fields, mi_src_hash}) + = rnf mi_module + `seq` rnf mi_sig_of + `seq` mi_hsc_src + `seq` mi_deps + `seq` mi_usages + `seq` mi_exports + `seq` rnf mi_used_th + `seq` mi_fixities + `seq` mi_warns + `seq` rnf mi_anns + `seq` rnf mi_decls + `seq` rnf mi_extra_decls + `seq` mi_globals + `seq` rnf mi_insts + `seq` rnf mi_fam_insts + `seq` rnf mi_rules + `seq` rnf mi_hpc + `seq` mi_trust + `seq` rnf mi_trust_pkg + `seq` rnf mi_complete_matches + `seq` rnf mi_docs + `seq` mi_final_exts + `seq` mi_ext_fields + `seq` rnf mi_src_hash `seq` () - instance NFData (ModIfaceBackend) where - rnf (ModIfaceBackend f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13) - = rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` - rnf f5 `seq` rnf f6 `seq` rnf f7 `seq` rnf f8 `seq` - rnf f9 `seq` rnf f10 `seq` rnf f11 `seq` rnf f12 `seq` rnf f13 + rnf (ModIfaceBackend{ mi_iface_hash, mi_mod_hash, mi_flag_hash, mi_opt_hash + , mi_hpc_hash, mi_plugin_hash, mi_orphan, mi_finsts, mi_exp_hash + , mi_orphan_hash, mi_warn_fn, mi_fix_fn, mi_hash_fn}) + = rnf mi_iface_hash + `seq` rnf mi_mod_hash + `seq` rnf mi_flag_hash + `seq` rnf mi_opt_hash + `seq` rnf mi_hpc_hash + `seq` rnf mi_plugin_hash + `seq` rnf mi_orphan + `seq` rnf mi_finsts + `seq` rnf mi_exp_hash + `seq` rnf mi_orphan_hash + `seq` rnf mi_warn_fn + `seq` rnf mi_fix_fn + `seq` rnf mi_hash_fn forceModIface :: ModIface -> IO () ===================================== libraries/base/Data/OldList.hs ===================================== @@ -1511,7 +1511,7 @@ sortOn :: Ord b => (a -> b) -> [a] -> [a] sortOn f = map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x)) --- | Produce singleton list. +-- | Construct a list from a single element. -- -- >>> singleton True -- [True] ===================================== libraries/base/tests/all.T ===================================== @@ -79,7 +79,9 @@ test('length001', # excessive amounts of stack space. So we specifically set a low # stack limit and mark it as failing under a few conditions. [extra_run_opts('+RTS -K8m -RTS'), - expect_fail_for(['normal', 'threaded1', 'llvm', 'nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc'])], + expect_fail_for(['normal', 'threaded1', 'llvm', 'nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc']), + # JS doesn't support stack limit so the test sometimes passes just fine. We decrease the timeout duration to force the failure. + when(js_arch(), run_timeout_multiplier(0.2))], compile_and_run, ['']) test('ratio001', normal, compile_and_run, ['']) ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -31,6 +31,7 @@ module Language.Haskell.TH.Syntax -- $infix ) where +import qualified Data.Fixed as Fixed import Data.Data hiding (Fixity(..)) import Data.IORef import System.IO.Unsafe ( unsafePerformIO ) @@ -1056,6 +1057,15 @@ instance Lift Natural where liftTyped x = unsafeCodeCoerce (lift x) lift x = return (LitE (IntegerL (fromIntegral x))) +instance Lift (Fixed.Fixed a) where + liftTyped x = unsafeCodeCoerce (lift x) + lift (Fixed.MkFixed x) = do + ex <- lift x + return (ConE mkFixedName `AppE` ex) + where + mkFixedName = + mkNameG DataName "base" "Data.Fixed" "MkFixed" + instance Integral a => Lift (Ratio a) where liftTyped x = unsafeCodeCoerce (lift x) lift x = return (LitE (RationalL (toRational x))) ===================================== libraries/template-haskell/changelog.md ===================================== @@ -7,6 +7,7 @@ * Add `TypeDataD` constructor to the `Dec` type for `type data` declarations (GHC proposal #106). + * Add `instance Lift (Fixed a)` ## 2.19.0.0 ===================================== rts/Capability.h ===================================== @@ -28,6 +28,14 @@ #include "BeginPrivate.h" +// We never want a Capability to overlap a cache line with +// anything else, so round it up to a cache line size: +#if defined(s390x_HOST_ARCH) +#define CAPABILITY_ALIGNMENT 256 +#elif !defined(mingw32_HOST_OS) +#define CAPABILITY_ALIGNMENT 64 +#endif + /* N.B. This must be consistent with CapabilityPublic in RtsAPI.h */ struct Capability_ { // State required by the STG virtual machine when running Haskell @@ -169,14 +177,11 @@ struct Capability_ { StgTRecHeader *free_trec_headers; uint32_t transaction_tokens; } // typedef Capability is defined in RtsAPI.h - // We never want a Capability to overlap a cache line with anything - // else, so round it up to a cache line size: -#if defined(s390x_HOST_ARCH) - ATTRIBUTE_ALIGNED(256) -#elif !defined(mingw32_HOST_OS) - ATTRIBUTE_ALIGNED(64) -#endif - ; + ATTRIBUTE_ALIGNED(CAPABILITY_ALIGNMENT); + +// We allocate arrays of Capabilities therefore we must ensure that the size is +// a multiple of the claimed alignment +GHC_STATIC_ASSERT(sizeof(struct Capability) % CAPABILITY_ALIGNMENT == 0, "Capability size does not match cache size"); #if defined(THREADED_RTS) #define ASSERT_TASK_ID(task) ASSERT(task->id == osThreadId()) ===================================== testsuite/driver/testlib.py ===================================== @@ -129,14 +129,17 @@ def no_deps( name, opts): def skip( name, opts ): opts.skip = True +def js_arch() -> bool: + return arch("javascript"); + # disable test on JS arch def js_skip( name, opts ): - if arch("javascript"): + if js_arch(): skip(name,opts) # expect broken for the JS backend def js_broken( bug: IssueNumber ): - if arch("javascript"): + if js_arch(): return expect_broken(bug); else: return normal; ===================================== testsuite/tests/simplCore/should_compile/T22761.hs ===================================== @@ -0,0 +1,40 @@ +module T22761 where + +import T22761a + +newtype Mod m = Mod m deriving Num + +gcdExt :: Integer -> (Integer, Integer) +gcdExt x = go 0 x + where + go !_ 0 = (1, 1) + go r _ = go r r + +pow :: (Num m) => Mod m -> Mod m +pow x = x*x*x +{-# NOINLINE [1] pow #-} +{-# RULES +"powMod/3/Int" forall x. pow x = x*x*x +#-} + + +-- GHC puts `boo1` after `wom1` (since they don't appear connected) +-- Then { wom1 = foo True } rewrites to { wom1 = boo False } +-- so we need to do glomming. And that triggers the bug +-- in the RULE for `pow`! +-- +-- wom2/boo2 are there to still elicit the bug if +-- GHC reverses its default ordering + +{-# RULES +"wombat1" foo True = boo1 False +#-} + +wom1 = foo True +boo1 x = x + +{-# RULES +"wombat2" foo True = boo2 False +#-} +boo2 x = x +wom2 = foo True ===================================== testsuite/tests/simplCore/should_compile/T22761a.hs ===================================== @@ -0,0 +1,4 @@ +module T22761a where + +{-# NOINLINE [0] foo #-} +foo x = x ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -471,5 +471,6 @@ test('T22611', [when(wordsize(32), skip), grep_errmsg(r'\$salterF') ], compile, test('T22715_2', normal, multimod_compile, ['T22715_2', '-v0 -O -fspecialise-aggressively']) test('T22802', normal, compile, ['-O']) test('T15205', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) +test('T22761', normal, multimod_compile, ['T22761', '-O2 -v0']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ce87953ac2978cd4865874c4f5b3409c726de5a6...01661e4eb0c467993f823903a10e80559ea9c249 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ce87953ac2978cd4865874c4f5b3409c726de5a6...01661e4eb0c467993f823903a10e80559ea9c249 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 18:24:08 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 13 Feb 2023 13:24:08 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 13 commits: Document that -fproc-alignment was introduced only in GHC 8.6 Message-ID: <63ea80484b145_26da8448900b8278942@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - fc05dc28 by Sven Tennie at 2023-02-13T13:22:43-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c4fde0c6 by amesgen at 2023-02-13T13:22:49-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b7554661 by Ben Gamari at 2023-02-13T13:22:49-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - 49690c7a by Oleg Grenrus at 2023-02-13T13:22:56-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - 08c73220 by PHO at 2023-02-13T13:23:01-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 9a7ede7b by PHO at 2023-02-13T13:23:03-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - a44b82ce by Li-yao Xia at 2023-02-13T13:23:08-05:00 base: Move changelog entry to its place - - - - - ad308fd5 by Ben Gamari at 2023-02-13T13:23:09-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - a2feb420 by Andreas Klebinger at 2023-02-13T13:23:10-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - f3f30615 by sheaf at 2023-02-13T13:23:15-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 12b83eb7 by Cheng Shao at 2023-02-13T13:23:16-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 3f91bc4e by Simon Hengel at 2023-02-13T13:23:20-05:00 Update outdated references to notes - - - - - 30 changed files: - .gitlab/rel_eng/upload_ghc_libs.py - compile_flags.txt - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Driver/Config/Stg/Pipeline.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Types.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Origin.hs-boot - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Fixity.hs - compiler/GHC/Types/ForeignCall.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/Language/Haskell/Syntax/Decls.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fc7e15618be30db1599170b9ba95eecc4e9b2486...3f91bc4ea25ba19932c06fc44c28b9aca4e7262c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fc7e15618be30db1599170b9ba95eecc4e9b2486...3f91bc4ea25ba19932c06fc44c28b9aca4e7262c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 18:38:05 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 13 Feb 2023 13:38:05 -0500 Subject: [Git][ghc/ghc][wip/T22965] rts: Statically assert alignment of Capability Message-ID: <63ea838df33c9_26da8449bc60828866f@gitlab.mail> Ben Gamari pushed to branch wip/T22965 at Glasgow Haskell Compiler / GHC Commits: 777aa4f4 by Ben Gamari at 2023-02-13T13:38:00-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 1 changed file: - rts/Capability.h Changes: ===================================== rts/Capability.h ===================================== @@ -28,6 +28,14 @@ #include "BeginPrivate.h" +// We never want a Capability to overlap a cache line with +// anything else, so round it up to a cache line size: +#if defined(s390x_HOST_ARCH) +#define CAPABILITY_ALIGNMENT 256 +#elif !defined(mingw32_HOST_OS) +#define CAPABILITY_ALIGNMENT 64 +#endif + /* N.B. This must be consistent with CapabilityPublic in RtsAPI.h */ struct Capability_ { // State required by the STG virtual machine when running Haskell @@ -169,14 +177,11 @@ struct Capability_ { StgTRecHeader *free_trec_headers; uint32_t transaction_tokens; } // typedef Capability is defined in RtsAPI.h - // We never want a Capability to overlap a cache line with anything - // else, so round it up to a cache line size: -#if defined(s390x_HOST_ARCH) - ATTRIBUTE_ALIGNED(256) -#elif !defined(mingw32_HOST_OS) - ATTRIBUTE_ALIGNED(64) -#endif - ; + ATTRIBUTE_ALIGNED(CAPABILITY_ALIGNMENT); + +// We allocate arrays of Capabilities therefore we must ensure that the size is +// a multiple of the claimed alignment +GHC_STATIC_ASSERT(sizeof(struct Capability_) % CAPABILITY_ALIGNMENT == 0, "Capability size does not match cache size"); #if defined(THREADED_RTS) #define ASSERT_TASK_ID(task) ASSERT(task->id == osThreadId()) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/777aa4f4754e8d11287a7e608259598b8838b964 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/777aa4f4754e8d11287a7e608259598b8838b964 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 18:38:47 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 13 Feb 2023 13:38:47 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T22965-9.2 Message-ID: <63ea83b74eddc_26da8449bc6d02890b9@gitlab.mail> Ben Gamari pushed new branch wip/T22965-9.2 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22965-9.2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 18:51:22 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 13 Feb 2023 13:51:22 -0500 Subject: [Git][ghc/ghc][wip/T22965-9.2] 2 commits: rts: Statically assert alignment of Capability Message-ID: <63ea86aa50285_26da8449bc5f4297475@gitlab.mail> Ben Gamari pushed to branch wip/T22965-9.2 at Glasgow Haskell Compiler / GHC Commits: d05dcb71 by Ben Gamari at 2023-02-13T13:51:13-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. (cherry picked from commit 01661e4eb0c467993f823903a10e80559ea9c249) - - - - - c3081e42 by Ben Gamari at 2023-02-13T13:51:13-05:00 rts: Fix alignment of Capability - - - - - 1 changed file: - rts/Capability.h Changes: ===================================== rts/Capability.h ===================================== @@ -27,6 +27,14 @@ #include "BeginPrivate.h" +// We never want a Capability to overlap a cache line with +// anything else, so round it up to a cache line size: +#if defined(s390x_HOST_ARCH) +#define CAPABILITY_ALIGNMENT 256 +#elif !defined(mingw32_HOST_OS) +#define CAPABILITY_ALIGNMENT 64 +#endif + /* N.B. This must be consistent with CapabilityPublic in RtsAPI.h */ struct Capability_ { // State required by the STG virtual machine when running Haskell @@ -171,15 +179,15 @@ struct Capability_ { StgTRecChunk *free_trec_chunks; StgTRecHeader *free_trec_headers; uint32_t transaction_tokens; + + // To ensure that size is multiple of CAPABILITY_ALIGNMENT. + StgWord _padding[0]; } // typedef Capability is defined in RtsAPI.h - // We never want a Capability to overlap a cache line with anything - // else, so round it up to a cache line size: -#if defined(s390x_HOST_ARCH) - ATTRIBUTE_ALIGNED(256) -#elif !defined(mingw32_HOST_OS) - ATTRIBUTE_ALIGNED(64) -#endif - ; + ATTRIBUTE_ALIGNED(CAPABILITY_ALIGNMENT); + +// We allocate arrays of Capabilities therefore we must ensure that the size is +// a multiple of the claimed alignment +GHC_STATIC_ASSERT(sizeof(struct Capability_) % CAPABILITY_ALIGNMENT == 0, "Capability size does not match cache size"); #if defined(THREADED_RTS) #define ASSERT_TASK_ID(task) ASSERT(task->id == osThreadId()) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bc1836bfd81c00c53b10b94d214c2bcb5f7d6148...c3081e42748b44441f7f888e379cd0264d82a963 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bc1836bfd81c00c53b10b94d214c2bcb5f7d6148...c3081e42748b44441f7f888e379cd0264d82a963 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 19:27:10 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 13 Feb 2023 14:27:10 -0500 Subject: [Git][ghc/ghc][wip/T22965] rts: Statically assert alignment of Capability Message-ID: <63ea8f0edc764_26da8448900b83146da@gitlab.mail> Ben Gamari pushed to branch wip/T22965 at Glasgow Haskell Compiler / GHC Commits: d5f765ce by Ben Gamari at 2023-02-13T14:27:02-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 1 changed file: - rts/Capability.h Changes: ===================================== rts/Capability.h ===================================== @@ -28,6 +28,14 @@ #include "BeginPrivate.h" +// We never want a Capability to overlap a cache line with +// anything else, so round it up to a cache line size: +#if defined(s390x_HOST_ARCH) +#define CAPABILITY_ALIGNMENT 256 +#elif !defined(mingw32_HOST_OS) +#define CAPABILITY_ALIGNMENT 64 +#endif + /* N.B. This must be consistent with CapabilityPublic in RtsAPI.h */ struct Capability_ { // State required by the STG virtual machine when running Haskell @@ -169,14 +177,16 @@ struct Capability_ { StgTRecHeader *free_trec_headers; uint32_t transaction_tokens; } // typedef Capability is defined in RtsAPI.h - // We never want a Capability to overlap a cache line with anything - // else, so round it up to a cache line size: -#if defined(s390x_HOST_ARCH) - ATTRIBUTE_ALIGNED(256) -#elif !defined(mingw32_HOST_OS) - ATTRIBUTE_ALIGNED(64) +#if defined(CAPABILITY_ALIGNMENT) + ATTRIBUTE_ALIGNED(CAPABILITY_ALIGNMENT) +#endif +; + +// We allocate arrays of Capabilities therefore we must ensure that the size is +// a multiple of the claimed alignment +#if defined(CAPABILITY_ALIGNMENT) +GHC_STATIC_ASSERT(sizeof(struct Capability_) % CAPABILITY_ALIGNMENT == 0, "Capability size does not match cache size"); #endif - ; #if defined(THREADED_RTS) #define ASSERT_TASK_ID(task) ASSERT(task->id == osThreadId()) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d5f765ce080f5f6877a32665a7b0a7c443805a84 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d5f765ce080f5f6877a32665a7b0a7c443805a84 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 19:32:01 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 13 Feb 2023 14:32:01 -0500 Subject: [Git][ghc/ghc][wip/T22965-9.2] 2 commits: rts: Statically assert alignment of Capability Message-ID: <63ea9031bc90_26da8449bc5f4318693@gitlab.mail> Ben Gamari pushed to branch wip/T22965-9.2 at Glasgow Haskell Compiler / GHC Commits: 8e6ac03c by Ben Gamari at 2023-02-13T14:31:52-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. (cherry picked from commit d5f765ce080f5f6877a32665a7b0a7c443805a84) - - - - - 918e4d67 by Ben Gamari at 2023-02-13T14:31:54-05:00 rts: Fix alignment of Capability - - - - - 1 changed file: - rts/Capability.h Changes: ===================================== rts/Capability.h ===================================== @@ -27,6 +27,14 @@ #include "BeginPrivate.h" +// We never want a Capability to overlap a cache line with +// anything else, so round it up to a cache line size: +#if defined(s390x_HOST_ARCH) +#define CAPABILITY_ALIGNMENT 256 +#elif !defined(mingw32_HOST_OS) +#define CAPABILITY_ALIGNMENT 64 +#endif + /* N.B. This must be consistent with CapabilityPublic in RtsAPI.h */ struct Capability_ { // State required by the STG virtual machine when running Haskell @@ -171,15 +179,20 @@ struct Capability_ { StgTRecChunk *free_trec_chunks; StgTRecHeader *free_trec_headers; uint32_t transaction_tokens; + + // To ensure that size is multiple of CAPABILITY_ALIGNMENT. + StgWord _padding[0]; } // typedef Capability is defined in RtsAPI.h - // We never want a Capability to overlap a cache line with anything - // else, so round it up to a cache line size: -#if defined(s390x_HOST_ARCH) - ATTRIBUTE_ALIGNED(256) -#elif !defined(mingw32_HOST_OS) - ATTRIBUTE_ALIGNED(64) +#if defined(CAPABILITY_ALIGNMENT) + ATTRIBUTE_ALIGNED(CAPABILITY_ALIGNMENT) +#endif +; + +// We allocate arrays of Capabilities therefore we must ensure that the size is +// a multiple of the claimed alignment +#if defined(CAPABILITY_ALIGNMENT) +GHC_STATIC_ASSERT(sizeof(struct Capability_) % CAPABILITY_ALIGNMENT == 0, "Capability size does not match cache size"); #endif - ; #if defined(THREADED_RTS) #define ASSERT_TASK_ID(task) ASSERT(task->id == osThreadId()) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c3081e42748b44441f7f888e379cd0264d82a963...918e4d672bca4db6986e9a394f2cfa787cb3c8e9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c3081e42748b44441f7f888e379cd0264d82a963...918e4d672bca4db6986e9a394f2cfa787cb3c8e9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 19:33:30 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 13 Feb 2023 14:33:30 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/plugins-abi-compat Message-ID: <63ea908a6640f_26da84369a944319048@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/plugins-abi-compat at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/plugins-abi-compat You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 19:51:29 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 13 Feb 2023 14:51:29 -0500 Subject: [Git][ghc/ghc][wip/T22965] 6 commits: Refresh profiling docs Message-ID: <63ea94c126734_26da844889a24323431@gitlab.mail> Ben Gamari pushed to branch wip/T22965 at Glasgow Haskell Compiler / GHC Commits: 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - b585225b by Ben Gamari at 2023-02-13T14:51:20-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 04336d2f by Ben Gamari at 2023-02-13T14:51:20-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 4af27fea by Ben Gamari at 2023-02-13T14:51:20-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. - - - - - 7 changed files: - docs/users_guide/debugging.rst - + docs/users_guide/images/eventlog_profile.png - docs/users_guide/profiling.rst - rts/Capability.c - rts/Capability.h - rts/RtsUtils.c - rts/RtsUtils.h Changes: ===================================== docs/users_guide/debugging.rst ===================================== @@ -1046,6 +1046,8 @@ Checking for consistency :shortdesc: Align functions at given boundary. :type: dynamic + :since: 8.6.1 + Align functions to multiples of the given value. Only valid values are powers of two. ===================================== docs/users_guide/images/eventlog_profile.png ===================================== Binary files /dev/null and b/docs/users_guide/images/eventlog_profile.png differ ===================================== docs/users_guide/profiling.rst ===================================== @@ -10,17 +10,13 @@ Profiling GHC comes with a time and space profiling system, so that you can answer questions like "why is my program so slow?", or "why is my program using -so much memory?". +so much memory?". We'll start by describing how to do time profiling. -Profiling a program is a three-step process: +Time profiling a program is a three-step process: 1. Re-compile your program for profiling with the :ghc-flag:`-prof` option, and probably one of the options for adding automatic annotations: - :ghc-flag:`-fprof-auto` is the most common [1]_. - - If you are using external packages with :command:`cabal`, you may need to - reinstall these packages with profiling support; typically this is - done with ``cabal install -p package --reinstall``. + :ghc-flag:`-fprof-late` is the recommended option. 2. Having compiled the program for profiling, you now need to run it to generate the profile. For example, a simple time profile can be @@ -37,6 +33,9 @@ Profiling a program is a three-step process: 3. Examine the generated profiling information, use the information to optimise your program, and repeat as necessary. +The time profiler measures the CPU time taken by the Haskell code in your application. +In particular time taken by safe foreign calls is not tracked by the profiler (see :ref:`prof-foreign-calls`). + .. _cost-centres: Cost centres and cost-centre stacks @@ -197,7 +196,10 @@ Inserting cost centres by hand Cost centres are just program annotations. When you say ``-fprof-auto`` to the compiler, it automatically inserts a cost centre annotation around every binding not marked INLINE in your program, but you are -entirely free to add cost centre annotations yourself. +entirely free to add cost centre annotations yourself. Be careful adding too many +cost-centre annotations as the optimiser is careful to not move them around or +remove them, which can severly affect how your program is optimised and hence the +runtime performance! The syntax of a cost centre annotation for expressions is :: @@ -311,6 +313,39 @@ and become CAFs. You will probably need to consult the Core .. index:: single: -fprof-cafs +.. _prof-foreign-calls: + +Profiling and foreign calls +--------------------------- + +Simply put, the profiler includes time spent in unsafe foreign +calls but ignores time taken in safe foreign calls. For example, time spent blocked on IO +operations (e.g. ``getLine``) is not accounted for in the profile as ``getLine`` is implemented +using a safe foreign call. + +The profiler estimates CPU time, for Haskell threads within the program only. +In particular, time "taken" by the program in blocking safe foreign calls +is not accounted for in time profiles. The runtime has the notion of a virtual +processor which is known as a "capability". Haskell threads are run on capabilities, +and the profiler samples the capabilities in order to determine what is being +executed at a certain time. When a safe foreign call is executed, it's run outside +the context of a capability; hence the sampling does not account for the time +taken. Whilst the safe call is executed, other +Haskell threads are free to run on the capability, and their cost will be attributed +to the profiler. When the safe call is finished, the blocked, descheduled thread can +be resumed and rescheduled. + +However, the time taken by blocking on unsafe foreign calls is accounted for in the profile. +This happens because unsafe foreign calls are executed by the same capability +their calling Haskell thread is running on. Therefore, an unsafe foreign call will +block the entire capability whilst it is running, and any time the capability is +sampled the "cost" of the foreign call will be attributed to the calling cost-centre stack. + +However, do note that you are not supposed to use unsafe foreign calls for any +operations which do block! Do not be tempted to replace your safe foreign calls +with unsafe calls just so they appear in the profile. This prevents GC from +happening until the foreign call returns, which can be catastrophic for performance. + .. _prof-compiler-options: Compiler options for profiling @@ -356,7 +391,9 @@ Automatically placing cost-centres ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ GHC has a number of flags for automatically inserting cost-centres into the -compiled program. +compiled program. Use these options carefully because inserting too many cost-centres +in the wrong places will mean the optimiser will be less effective and the runtime behaviour +of your profiled program will be different to that of the unprofiled one. .. ghc-flag:: -fprof-callers=⟨name⟩ :shortdesc: Auto-add ``SCC``\\ s to all call-sites of the named function. @@ -618,8 +655,10 @@ enclosed between ``+RTS ... -RTS`` as usual): JSON profile format ~~~~~~~~~~~~~~~~~~~ -When invoked with the :rts-flag:`-pj` flag the runtime will emit the cost-centre -profile in a machine-readable JSON format. The top-level object of this format +profile in a machine-readable JSON format. The JSON file can be directly loaded +into `speedscope.app `_ to interactively view the profile. + +The top-level object of this format has the following properties, ``program`` (string) @@ -758,8 +797,12 @@ For instance, a simple profile might look like this, } } +Eventlog profile format +~~~~~~~~~~~~~~~~~~~~~~~ - +In addition to the ``.prof`` and ``.json`` formats the cost centre definitions +and samples are also emitted to the :ref:`eventlog `. The format +of the events is specified in the :ref:`eventlog encodings ` section. .. _prof-heap: @@ -774,18 +817,35 @@ program holds on to more memory at run-time that it needs to. Space leaks lead to slower execution due to heavy garbage collector activity, and may even cause the program to run out of memory altogether. +Heap profiling differs from time profiling in the fact that is not always +necessary to use the profiling runtime to generate a heap profile. There +are two heap profiling modes (:rts-flag:`-hT` and :rts-flag:`-hi` [1]_) which are always +available. + To generate a heap profile from your program: -1. Compile the program for profiling (:ref:`prof-compiler-options`). +1. Assuming you need the profiling runtime, compile the program for profiling (:ref:`prof-compiler-options`). 2. Run it with one of the heap profiling options described below (eg. - :rts-flag:`-hc` for a basic producer profile). This generates the file - :file:`{prog}.hp`. + :rts-flag:`-hc` for a basic producer profile) and enable the eventlog using :rts-flag:`-l <-l ⟨flags⟩>`. - If the :ref:`event log ` is enabled (with the :rts-flag:`-l ⟨flags⟩` - runtime system flag) heap samples will additionally be emitted to the GHC + Heap samples will be emitted to the GHC event log (see :ref:`heap-profiler-events` for details about event format). +3. Render the heap profile using `eventlog2html `_. + This produces an HTML file which contains the visualised profile. + +4. Open the rendered interactive profile in your web browser. + +For example, here is a heap profile produced of using eventlog profiling on GHC +compiling the Cabal library. You can read a lot more about eventlog2html on the website. + +.. image:: images/eventlog_profile.* + +Note that there is the legacy :file:`{prog}.hp` format which has been deprecated +in favour of eventlog based profiling. In order to render the legacy format, the +steps are as follows. + 3. Run :command:`hp2ps` to produce a Postscript file, :file:`{prog}.ps`. The :command:`hp2ps` utility is described in detail in :ref:`hp2ps`. @@ -797,10 +857,6 @@ from GHC's ``nofib`` benchmark suite, .. image:: images/prof_scc.* -You might also want to take a look at -`hp2any `__, a more advanced -suite of tools (not distributed with GHC) for displaying heap profiles. - Note that there might be a big difference between the OS reported memory usage of your program and the amount of live data as reported by heap profiling. The reasons for the difference are explained in :ref:`hints-os-memory`. @@ -817,20 +873,14 @@ following RTS options select which break-down to use: .. rts-flag:: -hT - Breaks down the graph by heap closure type. + Breaks down the graph by heap closure type. This does not require the profiling + runtime. .. rts-flag:: -hc - -h *Requires* :ghc-flag:`-prof`. Breaks down the graph by the cost-centre stack which produced the data. - .. note:: The meaning of the shortened :rts-flag:`-h` is dependent on whether - your program was compiled for profiling. When compiled for profiling, - :rts-flag:`-h` is equivalent to :rts-flag:`-hc`, but otherwise is - equivalent to :rts-flag:`-hT` (see :ref:`rts-profiling`). The :rts-flag:`-h` - is deprecated and will be removed in a future release. - .. rts-flag:: -hm *Requires* :ghc-flag:`-prof`. Break down the live heap by the module @@ -863,7 +913,7 @@ following RTS options select which break-down to use: Break down the graph by the address of the info table of a closure. For this to produce useful output the program must have been compiled with - :ghc-flag:`-finfo-table-map`. + :ghc-flag:`-finfo-table-map` but it does not require the profiling runtime. .. rts-flag:: -l :noindex: @@ -1041,6 +1091,14 @@ This trick isn't foolproof, because there might be other ``B`` closures in the heap which aren't the retainers we are interested in, but we've found this to be a useful technique in most cases. +Precise Retainer Analysis +~~~~~~~~~~~~~~~~~~~~~~~~~ + +If you want to precisely answer questions about why a certain type of closure is +retained then it is worthwhile using `ghc-debug `_ which +has a terminal interface which can be used to easily answer queries such as, what is retaining +a certain closure. + .. _biography-prof: Biographical Profiling @@ -1120,6 +1178,9 @@ reasons for this: allocated by foreign libraries, and data allocated by the RTS), and ``mmap()``\'d memory are not counted in the heap profile. +For more discussion about understanding how understanding process residency see +:ref:`hints-os-memory`. + .. _hp2ps: ``hp2ps`` -- Rendering heap profiles to PostScript @@ -1242,123 +1303,6 @@ The flags are: Print out usage information. -.. _manipulating-hp: - -Manipulating the ``hp`` file -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -(Notes kindly offered by Jan-Willem Maessen.) - -The ``FOO.hp`` file produced when you ask for the heap profile of a -program ``FOO`` is a text file with a particularly simple structure. -Here's a representative example, with much of the actual data omitted: - -.. code-block:: none - - JOB "FOO -hC" - DATE "Thu Dec 26 18:17 2002" - SAMPLE_UNIT "seconds" - VALUE_UNIT "bytes" - BEGIN_SAMPLE 0.00 - END_SAMPLE 0.00 - BEGIN_SAMPLE 15.07 - ... sample data ... - END_SAMPLE 15.07 - BEGIN_SAMPLE 30.23 - ... sample data ... - END_SAMPLE 30.23 - ... etc. - BEGIN_SAMPLE 11695.47 - END_SAMPLE 11695.47 - -The first four lines (``JOB``, ``DATE``, ``SAMPLE_UNIT``, -``VALUE_UNIT``) form a header. Each block of lines starting with -``BEGIN_SAMPLE`` and ending with ``END_SAMPLE`` forms a single sample -(you can think of this as a vertical slice of your heap profile). The -hp2ps utility should accept any input with a properly-formatted header -followed by a series of *complete* samples. - -Zooming in on regions of your profile -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -You can look at particular regions of your profile simply by loading a -copy of the ``.hp`` file into a text editor and deleting the unwanted -samples. The resulting ``.hp`` file can be run through ``hp2ps`` and -viewed or printed. - -Viewing the heap profile of a running program -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -The ``.hp`` file is generated incrementally as your program runs. In -principle, running :command:`hp2ps` on the incomplete file should produce a -snapshot of your program's heap usage. However, the last sample in the -file may be incomplete, causing :command:`hp2ps` to fail. If you are using a -machine with UNIX utilities installed, it's not too hard to work around -this problem (though the resulting command line looks rather Byzantine): - -.. code-block:: sh - - head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \ - | hp2ps > FOO.ps - -The command ``fgrep -n END_SAMPLE FOO.hp`` finds the end of every -complete sample in ``FOO.hp``, and labels each sample with its ending -line number. We then select the line number of the last complete sample -using :command:`tail` and :command:`cut`. This is used as a parameter to :command:`head`; the -result is as if we deleted the final incomplete sample from :file:`FOO.hp`. -This results in a properly-formatted .hp file which we feed directly to -:command:`hp2ps`. - -Viewing a heap profile in real time -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -The :command:`gv` and :command:`ghostview` programs have a "watch file" option -can be used to view an up-to-date heap profile of your program as it runs. -Simply generate an incremental heap profile as described in the previous -section. Run :command:`gv` on your profile: - -.. code-block:: sh - - gv -watch -orientation=seascape FOO.ps - -If you forget the ``-watch`` flag you can still select "Watch file" from -the "State" menu. Now each time you generate a new profile ``FOO.ps`` -the view will update automatically. - -This can all be encapsulated in a little script: - -.. code-block:: sh - - #!/bin/sh - head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \ - | hp2ps > FOO.ps - gv -watch -orientation=seascape FOO.ps & - while [ 1 ] ; do - sleep 10 # We generate a new profile every 10 seconds. - head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \ - | hp2ps > FOO.ps - done - -Occasionally :command:`gv` will choke as it tries to read an incomplete copy of -:file:`FOO.ps` (because :command:`hp2ps` is still running as an update occurs). A -slightly more complicated script works around this problem, by using the -fact that sending a SIGHUP to gv will cause it to re-read its input -file: - -.. code-block:: sh - - #!/bin/sh - head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \ - | hp2ps > FOO.ps - gv FOO.ps & - gvpsnum=$! - while [ 1 ] ; do - sleep 10 - head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \ - | hp2ps > FOO.ps - kill -HUP $gvpsnum - done - .. _prof-threaded: Profiling Parallel and Concurrent Programs @@ -1968,10 +1912,9 @@ Notes about ticky profiling in some columns. For this reason using an eventlog-based approach should be prefered if possible. - .. [1] - :ghc-flag:`-fprof-auto` was known as ``-auto-all`` prior to - GHC 7.4.1. + :rts-flag:`-hi` profiling is avaible with the normal runtime but you will need to + compile with :ghc-flag:`-finfo-table-map` to interpret the results. .. [2] Note that this policy has changed slightly in GHC 7.4.1 relative to ===================================== rts/Capability.c ===================================== @@ -438,8 +438,9 @@ moreCapabilities (uint32_t from USED_IF_THREADS, uint32_t to USED_IF_THREADS) { for (uint32_t i = 0; i < to; i++) { if (i >= from) { - capabilities[i] = stgMallocBytes(sizeof(Capability), - "moreCapabilities"); + capabilities[i] = stgMallocAlignedBytes(sizeof(Capability), + CAPABILITY_ALIGNMENT, + "moreCapabilities"); initCapability(capabilities[i], i); } } ===================================== rts/Capability.h ===================================== @@ -28,6 +28,16 @@ #include "BeginPrivate.h" +// We never want a Capability to overlap a cache line with +// anything else, so round it up to a cache line size: +#if defined(s390x_HOST_ARCH) +#define CAPABILITY_ALIGNMENT 256 +#elif !defined(mingw32_HOST_OS) +#define CAPABILITY_ALIGNMENT 64 +#else +#define CAPABILITY_ALIGNMENT 1 +#endif + /* N.B. This must be consistent with CapabilityPublic in RtsAPI.h */ struct Capability_ { // State required by the STG virtual machine when running Haskell @@ -169,14 +179,12 @@ struct Capability_ { StgTRecHeader *free_trec_headers; uint32_t transaction_tokens; } // typedef Capability is defined in RtsAPI.h - // We never want a Capability to overlap a cache line with anything - // else, so round it up to a cache line size: -#if defined(s390x_HOST_ARCH) - ATTRIBUTE_ALIGNED(256) -#elif !defined(mingw32_HOST_OS) - ATTRIBUTE_ALIGNED(64) -#endif - ; + ATTRIBUTE_ALIGNED(CAPABILITY_ALIGNMENT) +; + +// We allocate arrays of Capabilities therefore we must ensure that the size is +// a multiple of the claimed alignment +GHC_STATIC_ASSERT(sizeof(struct Capability_) % CAPABILITY_ALIGNMENT == 0, "Capability size does not match cache size"); #if defined(THREADED_RTS) #define ASSERT_TASK_ID(task) ASSERT(task->id == osThreadId()) ===================================== rts/RtsUtils.c ===================================== @@ -56,10 +56,45 @@ extern char *ctime_r(const time_t *, char *); void * stgMallocBytes (size_t n, char *msg) +{ + void *space = malloc(n); + + if (space == NULL) { + /* Quoting POSIX.1-2008 (which says more or less the same as ISO C99): + * + * "Upon successful completion with size not equal to 0, malloc() shall + * return a pointer to the allocated space. If size is 0, either a null + * pointer or a unique pointer that can be successfully passed to free() + * shall be returned. Otherwise, it shall return a null pointer and set + * errno to indicate the error." + * + * Consequently, a NULL pointer being returned by `malloc()` for a 0-size + * allocation is *not* to be considered an error. + */ + if (n == 0) return NULL; + + /* don't fflush(stdout); WORKAROUND bug in Linux glibc */ + rtsConfig.mallocFailHook((W_) n, msg); + stg_exit(EXIT_INTERNAL_ERROR); + } + IF_DEBUG(zero_on_gc, memset(space, 0xbb, n)); + return space; +} + +void * +stgMallocAlignedBytes (size_t n, size_t align, char *msg) { void *space; - if ((space = malloc(n)) == NULL) { +#if defined(mingw32_HOST_OS) + space = _aligned_malloc(n, align); +#else + if (posix_memalign(&space, align, n)) { + space = NULL; // Allocation failed + } +#endif + + if (space == NULL) { /* Quoting POSIX.1-2008 (which says more or less the same as ISO C99): * * "Upon successful completion with size not equal to 0, malloc() shall ===================================== rts/RtsUtils.h ===================================== @@ -29,6 +29,10 @@ void *stgMallocBytes(size_t n, char *msg) * See: https://gitlab.haskell.org/ghc/ghc/-/issues/22380 */ +void *stgMallocAlignedBytes(size_t n, size_t align, char *msg) + STG_MALLOC STG_MALLOC1(stgFree) + STG_ALLOC_SIZE1(1); + void *stgReallocBytes(void *p, size_t n, char *msg) STG_MALLOC1(stgFree) STG_ALLOC_SIZE1(2) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d5f765ce080f5f6877a32665a7b0a7c443805a84...4af27feabf482cf6b611951443e05ee7e53acb39 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d5f765ce080f5f6877a32665a7b0a7c443805a84...4af27feabf482cf6b611951443e05ee7e53acb39 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 19:53:30 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 13 Feb 2023 14:53:30 -0500 Subject: [Git][ghc/ghc][wip/romes/plugins-abi-compat] fix: Prevent loading plugins linked with ABI incompatible packages Message-ID: <63ea953ad6505_26da8449bc5f43252e0@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/plugins-abi-compat at Glasgow Haskell Compiler / GHC Commits: 4df21502 by romes at 2023-02-13T19:53:22+00:00 fix: Prevent loading plugins linked with ABI incompatible packages Note [Loading Plugins] ~~~~~~~~~~~~~~~~~~~~~~ When loading plugins, we must be careful to check that certain packages we depend on, like ghc the library, are ABI compatible with the packages the plugin was linked against. Currently, ghc the library and the boot packages don't have an ABI hash in their identifier. Consequently, when loading a plugin that was linked against ghc-v-xxx into a module that is being linked against ghc-v-yyy, we must (somehow) guarantee that xxx and yyy are indeed the same, which isn't trivial because xxx and yyy aren't available in the package identifier. Or we risk linking the plugin against an incompatible ghc of the same version, leading to crashes and segmentation faults (since the loaded plugin will make use of an incompatible library thinking it's compatible). A solution is to re-compute the ABI hash of the plugin being loaded and compare it against the ABI hash of the plugin as computed by the compiler that compiled it. If the hashes are one and the same, it's safe to load the plugin. -- Because the ABI hash (see addFingerprints) depends on ... ? See also #20742 - - - - - 1 changed file: - compiler/GHC/Runtime/Loader.hs Changes: ===================================== compiler/GHC/Runtime/Loader.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Runtime.Interpreter.Types import GHC.Tc.Utils.Monad ( initTcInteractive, initIfaceTcRn ) import GHC.Iface.Load ( loadPluginInterface, cannotFindModule ) +import GHC.Iface.Recomp ( addFingerprints ) import GHC.Rename.Names ( gresFromAvails ) import GHC.Builtin.Names ( pluginTyConName, frontendPluginTyConName ) @@ -156,10 +157,42 @@ checkExternalInterpreter hsc_env = case interpInstance <$> hsc_interp hsc_env of -> throwIO (InstallationError "Plugins require -fno-external-interpreter") _ -> pure () +{- +Note [Loading Plugins] +~~~~~~~~~~~~~~~~~~~~~~ + + +When loading plugins, we must be careful to check that certain packages we +depend on, like ghc the library, are ABI compatible with the packages the +plugin was linked against. + +Currently, ghc the library and the boot packages don't have an ABI hash in +their identifier. Consequently, when loading a plugin that was linked against +ghc-v-xxx into a module that is being linked against ghc-v-yyy, we must +(somehow) guarantee that xxx and yyy are indeed the same, which isn't trivial +because xxx and yyy aren't available in the package identifier. Or we risk +linking the plugin against an incompatible ghc of the same version, leading to +crashes and segmentation faults (since the loaded plugin will make use of an +incompatible library thinking it's compatible). + +A solution is to re-compute the ABI hash of the plugin being loaded and compare +it against the ABI hash of the plugin as computed by the compiler that compiled +it. If the hashes are one and the same, it's safe to load the plugin. + +-- Because the ABI hash (see addFingerprints) depends on ... ? + +See also #20742 + + +-} + loadPlugin' :: OccName -> Name -> HscEnv -> ModuleName -> IO (a, ModIface, [Linkable], PkgsLoaded) loadPlugin' occ_name plugin_name hsc_env mod_name = do { let plugin_rdr_name = mkRdrQual mod_name occ_name dflags = hsc_dflags hsc_env + + -- Find plugin_name (e.g. "plugin", "frontendPlugin") + -- in the module of the plugin to load ; mb_name <- lookupRdrNameInModuleForPlugins hsc_env mod_name plugin_rdr_name ; case mb_name of { @@ -168,8 +201,21 @@ loadPlugin' occ_name plugin_name hsc_env mod_name [ text "The module", ppr mod_name , text "did not export the plugin name" , ppr plugin_rdr_name ]) ; + -- The modiface of the plugin as compiled by possibly other compiler Just (name, mod_iface) -> + -- The modiface of the plugin as compiled by us + do { our_mod_iface <- addFingerprints hsc_env + (mod_iface{mi_final_exts = (), mi_decls = map snd (mi_decls mod_iface)}) + + -- Compare ABI hashes of module being loaded. See Note [Loading Plugins] + ; if mi_mod_hash (mi_final_exts mod_iface) /= mi_mod_hash (mi_final_exts our_mod_iface) + then + throwGhcExceptionIO (CmdLineError $ showSDoc dflags $ hsep + [ text "The plugin", ppr mod_name + , text "was built with a compiler that is ABI incompatible with the one loading it" + ]) ; + else -- pprTrace "(Their ABI hash, Our ABI Hash):" (ppr (mi_mod_hash $ mi_final_exts mod_iface, mi_mod_hash $ mi_final_exts our_mod_iface)) $ do { plugin_tycon <- forceLoadTyCon hsc_env plugin_name ; eith_plugin <- getValueSafely hsc_env name (mkTyConTy plugin_tycon) ; case eith_plugin of @@ -182,7 +228,7 @@ loadPlugin' occ_name plugin_name hsc_env mod_name , text "did not have the type" , text "GHC.Plugins.Plugin" , text "as required"]) - Right (plugin, links, pkgs) -> return (plugin, mod_iface, links, pkgs) } } } + Right (plugin, links, pkgs) -> return (plugin, mod_iface, links, pkgs) } } } } -- | Force the interfaces for the given modules to be loaded. The 'SDoc' parameter is used View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4df21502a0c329e28bfb050fed38cabe11a8f7cb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4df21502a0c329e28bfb050fed38cabe11a8f7cb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 19:58:16 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 13 Feb 2023 14:58:16 -0500 Subject: [Git][ghc/ghc][wip/T22965-9.2] 4 commits: rts: Statically assert alignment of Capability Message-ID: <63ea96584f93f_26da8449bc60832711a@gitlab.mail> Ben Gamari pushed to branch wip/T22965-9.2 at Glasgow Haskell Compiler / GHC Commits: 489215f0 by Ben Gamari at 2023-02-13T14:51:49-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. (cherry picked from commit b585225be9670de1a83e0bb17034d2fb821cb8a3) - - - - - 66f7ee57 by Ben Gamari at 2023-02-13T14:51:51-05:00 rts: Fix alignment of Capability - - - - - 1332f1f4 by Ben Gamari at 2023-02-13T14:58:10-05:00 rts: Introduce stgMallocAlignedBytes (cherry picked from commit 04336d2f11e49f7d00392f05d4fd48abdd231fc0) - - - - - 1741fd25 by Ben Gamari at 2023-02-13T14:58:10-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. (cherry picked from commit 4af27feabf482cf6b611951443e05ee7e53acb39) - - - - - 4 changed files: - rts/Capability.c - rts/Capability.h - rts/RtsUtils.c - rts/RtsUtils.h Changes: ===================================== rts/Capability.c ===================================== @@ -439,8 +439,9 @@ moreCapabilities (uint32_t from USED_IF_THREADS, uint32_t to USED_IF_THREADS) if (i < from) { new_capabilities[i] = capabilities[i]; } else { - new_capabilities[i] = stgMallocBytes(sizeof(Capability), - "moreCapabilities"); + new_capabilities[i] = stgMallocAlignedBytes(sizeof(Capability), + CAPABILITY_ALIGNMENT, + "moreCapabilities"); initCapability(new_capabilities[i], i); } } ===================================== rts/Capability.h ===================================== @@ -27,6 +27,16 @@ #include "BeginPrivate.h" +// We never want a Capability to overlap a cache line with +// anything else, so round it up to a cache line size: +#if defined(s390x_HOST_ARCH) +#define CAPABILITY_ALIGNMENT 256 +#elif !defined(mingw32_HOST_OS) +#define CAPABILITY_ALIGNMENT 64 +#else +#define CAPABILITY_ALIGNMENT 1 +#endif + /* N.B. This must be consistent with CapabilityPublic in RtsAPI.h */ struct Capability_ { // State required by the STG virtual machine when running Haskell @@ -171,15 +181,16 @@ struct Capability_ { StgTRecChunk *free_trec_chunks; StgTRecHeader *free_trec_headers; uint32_t transaction_tokens; + + // To ensure that size is multiple of CAPABILITY_ALIGNMENT. + StgWord _padding[0]; } // typedef Capability is defined in RtsAPI.h - // We never want a Capability to overlap a cache line with anything - // else, so round it up to a cache line size: -#if defined(s390x_HOST_ARCH) - ATTRIBUTE_ALIGNED(256) -#elif !defined(mingw32_HOST_OS) - ATTRIBUTE_ALIGNED(64) -#endif - ; + ATTRIBUTE_ALIGNED(CAPABILITY_ALIGNMENT) +; + +// We allocate arrays of Capabilities therefore we must ensure that the size is +// a multiple of the claimed alignment +GHC_STATIC_ASSERT(sizeof(struct Capability_) % CAPABILITY_ALIGNMENT == 0, "Capability size does not match cache size"); #if defined(THREADED_RTS) #define ASSERT_TASK_ID(task) ASSERT(task->id == osThreadId()) ===================================== rts/RtsUtils.c ===================================== @@ -58,10 +58,45 @@ extern char *ctime_r(const time_t *, char *); void * stgMallocBytes (size_t n, char *msg) +{ + void *space = malloc(n); + + if (space == NULL) { + /* Quoting POSIX.1-2008 (which says more or less the same as ISO C99): + * + * "Upon successful completion with size not equal to 0, malloc() shall + * return a pointer to the allocated space. If size is 0, either a null + * pointer or a unique pointer that can be successfully passed to free() + * shall be returned. Otherwise, it shall return a null pointer and set + * errno to indicate the error." + * + * Consequently, a NULL pointer being returned by `malloc()` for a 0-size + * allocation is *not* to be considered an error. + */ + if (n == 0) return NULL; + + /* don't fflush(stdout); WORKAROUND bug in Linux glibc */ + rtsConfig.mallocFailHook((W_) n, msg); + stg_exit(EXIT_INTERNAL_ERROR); + } + IF_DEBUG(zero_on_gc, memset(space, 0xbb, n)); + return space; +} + +void * +stgMallocAlignedBytes (size_t n, size_t align, char *msg) { void *space; - if ((space = malloc(n)) == NULL) { +#if defined(mingw32_HOST_OS) + space = _aligned_malloc(n, align); +#else + if (posix_memalign(&space, align, n)) { + space = NULL; // Allocation failed + } +#endif + + if (space == NULL) { /* Quoting POSIX.1-2008 (which says more or less the same as ISO C99): * * "Upon successful completion with size not equal to 0, malloc() shall ===================================== rts/RtsUtils.h ===================================== @@ -20,6 +20,8 @@ void shutdownAllocator(void); void *stgMallocBytes(size_t n, char *msg) GNUC3_ATTRIBUTE(__malloc__); +void *stgMallocAlignedBytes(size_t n, size_t align, char *msg); + void *stgReallocBytes(void *p, size_t n, char *msg); void *stgCallocBytes(size_t count, size_t size, char *msg) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/918e4d672bca4db6986e9a394f2cfa787cb3c8e9...1741fd255842706a9f15c95cd8c1c6b7784c50ce -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/918e4d672bca4db6986e9a394f2cfa787cb3c8e9...1741fd255842706a9f15c95cd8c1c6b7784c50ce You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 20:24:18 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 13 Feb 2023 15:24:18 -0500 Subject: [Git][ghc/ghc][wip/T22965] rts: Correctly align Capability allocations Message-ID: <63ea9c72529cb_26da8448900b83350f0@gitlab.mail> Ben Gamari pushed to branch wip/T22965 at Glasgow Haskell Compiler / GHC Commits: 1aaefa1e by Ben Gamari at 2023-02-13T15:23:59-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 1 changed file: - rts/Capability.c Changes: ===================================== rts/Capability.c ===================================== @@ -438,8 +438,9 @@ moreCapabilities (uint32_t from USED_IF_THREADS, uint32_t to USED_IF_THREADS) { for (uint32_t i = 0; i < to; i++) { if (i >= from) { - capabilities[i] = stgMallocBytes(sizeof(Capability), - "moreCapabilities"); + capabilities[i] = stgMallocAlignedBytes(sizeof(Capability), + CAPABILITY_ALIGNMENT, + "moreCapabilities"); initCapability(capabilities[i], i); } } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1aaefa1e24ffafaabb4df01b9e3ae2ea2a9257e9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1aaefa1e24ffafaabb4df01b9e3ae2ea2a9257e9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 20:36:26 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Mon, 13 Feb 2023 15:36:26 -0500 Subject: [Git][ghc/ghc][wip/t21766] Update user's guide and release notes Message-ID: <63ea9f4adaceb_26da8448900e033549d@gitlab.mail> Finley McIlwaine pushed to branch wip/t21766 at Glasgow Haskell Compiler / GHC Commits: 0c1685ab by Finley McIlwaine at 2023-02-13T13:35:57-07:00 Update user's guide and release notes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. See ticket #21766 - - - - - 5 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debug-info.rst - testsuite/tests/rts/ipe/ipeMap.c Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -228,10 +228,6 @@ debug = vanilla { buildFlavour = SlowValidate , withAssertions = True -- WithNuma so at least one job tests Numa , withNuma = True - - -- Build with IPE in debug so at least one job tests - -- uncompressed IPE data - , withIpe = True } ipe :: BuildConfig @@ -878,7 +874,6 @@ job_groups = , validateBuilds Amd64 (Linux Debian10) nativeInt , fastCI (validateBuilds Amd64 (Linux Debian10) unreg) , fastCI (validateBuilds Amd64 (Linux Debian10) debug) - , disableValidate (validateBuilds Amd64 (Linux Debian10) ipe) , modifyValidateJobs manual tsan_jobs , modifyValidateJobs manual (validateBuilds Amd64 (Linux Debian10) noTntc) , addValidateRule LLVMBackend (validateBuilds Amd64 (Linux Debian10) llvm) ===================================== .gitlab/jobs.yaml ===================================== @@ -1031,7 +1031,7 @@ "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb10-numa-slow-validate+ipe": { + "nightly-x86_64-linux-deb10-numa-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -1041,7 +1041,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-deb10-numa-slow-validate+ipe.tar.xz", + "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", "junit.xml" ], "reports": { @@ -1083,11 +1083,11 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate+ipe", - "BUILD_FLAVOUR": "slow-validate+ipe", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate", + "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", - "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate+ipe", + "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate", "XZ_OPT": "-9" } }, @@ -3698,7 +3698,7 @@ "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate" } }, - "x86_64-linux-deb10-numa-slow-validate+ipe": { + "x86_64-linux-deb10-numa-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -3708,7 +3708,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb10-numa-slow-validate+ipe.tar.xz", + "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", "junit.xml" ], "reports": { @@ -3750,11 +3750,11 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate+ipe", - "BUILD_FLAVOUR": "slow-validate+ipe", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate", + "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", - "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate+ipe" + "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate" } }, "x86_64-linux-deb10-unreg-validate": { ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -21,6 +21,17 @@ Compiler foo (\x -> x*2 + x) +- The compiler may now be configured to compress the debugging information + included in :ghc-flag:`-finfo-table-map` enabled binaries. To do so, one must + build GHC from source (see + `here` for directions) + and supply the ``--enable-ipe-data-compression`` flag to the ``configure`` + script. **Note**: This feature requires that the machine building GHC has + `libzstd `_ installed. + + In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map` + enabled build results was reduced by over 20% when compression was enabled. + GHCi ~~~~ ===================================== docs/users_guide/debug-info.rst ===================================== @@ -370,9 +370,23 @@ to a source location. This lookup table is generated by using the ``-finfo-table also want more precise information about constructor info tables then you should also use :ghc-flag:`-fdistinct-constructor-tables`. - This flag will increase the binary size by quite a lot, depending on how - big your project is. For compiling a project the size of GHC the overhead was - about 200 megabytes. + The :ghc-flag:`-finfo-table-map` flag will increase the binary size by quite + a lot, depending on how big your project is. For compiling a project the + size of GHC the overhead was about 200 megabytes. + + :since: 9.8 + + If you wish to reduce the size of :ghc-flag:`-finfo-table-map` enabled + binaries, consider building GHC from source and supplying the + ``--enable-ipe-data-compression`` flag to the ``configure`` script. This + will cause GHC to compress the :ghc-flag:`-finfo-table-map` related + debugging information included in binaries using the `libzstd + `_ compression library. **Note**: This + feature requires that the machine building GHC has + `libzstd `_ installed. + + In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map` + enabled build results was reduced by over 20% when compression was enabled. .. ghc-flag:: -fdistinct-constructor-tables :shortdesc: Generate a fresh info table for each usage ===================================== testsuite/tests/rts/ipe/ipeMap.c ===================================== @@ -161,6 +161,7 @@ void shouldFindTwoFromTheSameList(Capability *cap) { void shouldDealWithAnEmptyList(Capability *cap, HaskellObj fortyTwo) { IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); node->count = 0; + node->compressed = 0; node->next = NULL; node->string_table = ""; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0c1685abc9ad345ff22b3ad4434847f43d382732 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0c1685abc9ad345ff22b3ad4434847f43d382732 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 20:36:58 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Mon, 13 Feb 2023 15:36:58 -0500 Subject: [Git][ghc/ghc][wip/t21766] 27 commits: Fix tyvar scoping within class SPECIALISE pragmas Message-ID: <63ea9f6a66c4_26da8449bc6a8336072@gitlab.mail> Finley McIlwaine pushed to branch wip/t21766 at Glasgow Haskell Compiler / GHC Commits: 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 1eabc389 by Finley McIlwaine at 2023-02-13T13:36:49-07:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - c470704c by Finley McIlwaine at 2023-02-13T13:36:49-07:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - 159566d2 by Finley McIlwaine at 2023-02-13T13:36:49-07:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - 347ee3eb by Finley McIlwaine at 2023-02-13T13:36:49-07:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - c69fd134 by Finley McIlwaine at 2023-02-13T13:36:49-07:00 Add note describing IPE data compression See ticket #21766 - - - - - 6e51f9b8 by Finley McIlwaine at 2023-02-13T13:36:49-07:00 Fix byte order of IPE data, fix IPE tests Make sure byte order of written IPE buffer entries matches target. Make sure the IPE-related tests properly access the fields of IPE buffer entry nodes with the new IPE layout. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. See ticket #21766. - - - - - 4d8e65c9 by Finley McIlwaine at 2023-02-13T13:36:49-07:00 Fix IPE data decompression buffer allocation Capacity of buffers allocated for decompressed IPE data was incorrect due to a misuse of the `ZSTD_findFrameCompressedSize` function. Fix by always storing decompressed size of IPE data in IPE buffer list nodes and using `ZSTD_findFrameCompressedSize` to determine the size of the compressed data. See ticket #21766 - - - - - 23950822 by Finley McIlwaine at 2023-02-13T13:36:49-07:00 Add optional dependencies to ./configure output Changes the configure script to indicate whether libnuma, libzstd, or libdw are being used as dependencies due to their optional features being enabled. - - - - - 0d7477db by Finley McIlwaine at 2023-02-13T13:36:49-07:00 Add IPE-enabled builds to CI - Adds an IPE job to the CI pipeline which is triggered by the ~IPE label - Introduces CI logic to enable IPE data compression - Enables uncompressed IPE data on debug CI job - Regenerates jobs.yaml MR https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/112 on the images repository is meant to ensure that the proper images have libzstd-dev installed. - - - - - 0d9966c8 by Finley McIlwaine at 2023-02-13T13:36:49-07:00 Update user's guide and release notes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. See ticket #21766 - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Rename/Bind.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Unit/Module/ModIface.hs - compiler/ghc.cabal.in - configure.ac - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debug-info.rst - docs/users_guide/debugging.rst - + docs/users_guide/images/eventlog_profile.png - docs/users_guide/profiling.rst - hadrian/cfg/system.config.in The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0c1685abc9ad345ff22b3ad4434847f43d382732...0d9966c83bdb6fb461a99ec9507abc1ad331aa22 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0c1685abc9ad345ff22b3ad4434847f43d382732...0d9966c83bdb6fb461a99ec9507abc1ad331aa22 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 21:31:16 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 13 Feb 2023 16:31:16 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T22194 Message-ID: <63eaac247fd54_26da8449bc6a8354974@gitlab.mail> Apoorv Ingle pushed new branch wip/T22194 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22194 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 21:37:31 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 13 Feb 2023 16:37:31 -0500 Subject: [Git][ghc/ghc][wip/T22924] 4 commits: Refresh profiling docs Message-ID: <63eaad9bc2faf_26da8449bc6a8355165@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22924 at Glasgow Haskell Compiler / GHC Commits: 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 2b0d4d28 by Simon Peyton Jones at 2023-02-13T22:37:19+01:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 14 changed files: - compiler/GHC/Core/TyCon.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Rewrite.hs - docs/users_guide/debugging.rst - + docs/users_guide/images/eventlog_profile.png - docs/users_guide/profiling.rst - + testsuite/tests/typecheck/should_compile/T22924.hs - testsuite/tests/typecheck/should_compile/all.T - + testsuite/tests/typecheck/should_fail/T22924a.hs - + testsuite/tests/typecheck/should_fail/T22924a.stderr - + testsuite/tests/typecheck/should_fail/T22924b.hs - + testsuite/tests/typecheck/should_fail/T22924b.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -1974,7 +1974,7 @@ isInjectiveTyCon :: TyCon -> Role -> Bool isInjectiveTyCon (TyCon { tyConDetails = details }) role = go details role where - go _ Phantom = True -- Vacuously; (t1 ~P t2) holes for all t1, t2! + go _ Phantom = True -- Vacuously; (t1 ~P t2) holds for all t1, t2! go (AlgTyCon {}) Nominal = True go (AlgTyCon {algTcRhs = rhs}) Representational = isGenInjAlgRhs rhs ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -1084,7 +1084,7 @@ can_eq_nc' _rewritten _rdr_env _envs ev eq_rel -- Decompose type constructor applications -- NB: we have expanded type synonyms already -can_eq_nc' rewritten _rdr_env _envs ev eq_rel ty1 _ ty2 _ +can_eq_nc' _rewritten _rdr_env _envs ev eq_rel ty1 _ ty2 _ | Just (tc1, tys1) <- tcSplitTyConApp_maybe ty1 , Just (tc2, tys2) <- tcSplitTyConApp_maybe ty2 -- we want to catch e.g. Maybe Int ~ (Int -> Int) here for better @@ -1092,7 +1092,7 @@ can_eq_nc' rewritten _rdr_env _envs ev eq_rel ty1 _ ty2 _ -- hence no direct match on TyConApp , not (isTypeFamilyTyCon tc1) , not (isTypeFamilyTyCon tc2) - = canTyConApp rewritten ev eq_rel tc1 tys1 tc2 tys2 + = canTyConApp ev eq_rel tc1 tys1 tc2 tys2 can_eq_nc' _rewritten _rdr_env _envs ev eq_rel s1@(ForAllTy (Bndr _ vis1) _) _ @@ -1114,8 +1114,12 @@ can_eq_nc' True _rdr_env _envs ev NomEq ty1 _ ty2 _ ------------------- -- No similarity in type structure detected. Rewrite and try again. -can_eq_nc' False _rdr_env _envs ev eq_rel _ ps_ty1 _ ps_ty2 - = rewrite_and_try_again ev eq_rel ps_ty1 ps_ty2 +can_eq_nc' False rdr_env envs ev eq_rel _ ps_ty1 _ ps_ty2 + = -- Rewrite the two types and try again + do { (redn1@(Reduction _ xi1), rewriters1) <- rewrite ev ps_ty1 + ; (redn2@(Reduction _ xi2), rewriters2) <- rewrite ev ps_ty2 + ; new_ev <- rewriteEqEvidence (rewriters1 S.<> rewriters2) ev NotSwapped redn1 redn2 + ; can_eq_nc' True rdr_env envs new_ev eq_rel xi1 xi1 xi2 xi2 } ---------------------------- -- Look for a canonical LHS. See Note [Canonical LHS]. @@ -1153,15 +1157,6 @@ can_eq_nc' True _rdr_env _envs ev eq_rel _ ps_ty1 _ ps_ty2 -- No need to call canEqFailure/canEqHardFailure because they -- rewrite, and the types involved here are already rewritten --- Rewrite the two types and try again -rewrite_and_try_again :: CtEvidence -> EqRel -> TcType -> TcType -> TcS (StopOrContinue Ct) -rewrite_and_try_again ev eq_rel ty1 ty2 - = do { (redn1@(Reduction _ xi1), rewriters1) <- rewrite ev ty1 - ; (redn2@(Reduction _ xi2), rewriters2) <- rewrite ev ty2 - ; new_ev <- rewriteEqEvidence (rewriters1 S.<> rewriters2) ev NotSwapped redn1 redn2 - ; rdr_env <- getGlobalRdrEnvTcS - ; envs <- getFamInstEnvs - ; can_eq_nc' True rdr_env envs new_ev eq_rel xi1 xi1 xi2 xi2 } {- Note [Unsolved equalities] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1407,62 +1402,41 @@ which is easier to satisfy. Conclusion: we must unwrap newtypes before decomposing them. This happens in `can_eq_newtype_nc` -But even this is challenging. Here are two cases to consider: - -Case 1: - - newtype Age = MkAge Int - [G] c - [W] w1 :: IO Age ~R# IO Int - -Case 2: - - newtype A = MkA [A] - [W] A ~R# [A] - -For Case 1, recall that IO is an abstract newtype. Then read Note -[Decomposing newtype equalities]. According to that Note, we should not -decompose w1, because we have an Irred Given. Yet we still want to solve -the wanted! We can do so by unwrapping the (non-abstract) Age newtype -underneath the IO, giving - [W] w2 :: IO Int ~R# IO Int - w1 = (IO unwrap-Age ; w2) -where unwrap-Age :: Age ~R# Int. Now we case solve w2 by reflexivity; -see Note [Eager reflexivity check]. - -Conclusion: unwrap newtypes (deeply, inside types) in the rewriter: -specifically in GHC.Tc.Solver.Rewrite.rewrite_newtype_app. - -Yet for Case 2, deep rewriting would be a disaster: we would loop. - [W] A ~R# [A] ---> {unwrap} - [W] [A] ~R# [[A]] - ---> {decompose} - [W] A ~R# [A] - -In this case, we just want to unwrap newtypes /at the top level/, allowing us -to succeed via Note [Eager reflexivity check]: - [W] A ~R# [A] ---> {unwrap at top level only} - [W] [A] ~R# [A] - ---> {reflexivity} success - -Conclusion: to satisfy Case 1 and Case 2, we unwrap -* /both/ at top level, in can_eq_nc' -* /and/ deeply, in the rewriter, rewrite_newtype_app - -The former unwraps outer newtypes (when the data constructor is in scope). -The latter unwraps deeply -- but it won't be invoked in Case 2, when we can -recognize an equality between the types [A] and [A] before rewriting -deeply. - -This "before" business is delicate -- there is still a real risk of a loop -in the type checker with recursive newtypes -- but I think we're doomed to do -*something* delicate, as we're really trying to solve for equirecursive -type equality. Bottom line for users: recursive newtypes are dangerous. -See also Section 5.3.1 and 5.3.4 of +We did flirt with making the /rewriter/ expand newtypes, rather than +doing it in `can_eq_newtype_nc`. But with recursive newtypes we want +to be super-careful about expanding! + + newtype A = MkA [A] -- Recursive! + + f :: A -> [A] + f = coerce + +We have [W] A ~R# [A]. If we rewrite [A], it'll expand to + [[[[[...]]]]] +and blow the reduction stack. See Note [Newtypes can blow the stack] +in GHC.Tc.Solver.Rewrite. But if we expand only the /top level/ of +both sides, we get + [W] [A] ~R# [A] +which we can, just, solve by reflexivity. + +So we simply unwrap, on-demand, at top level, in `can_eq_newtype_nc`. + +This is all very delicate. There is a real risk of a loop in the type checker +with recursive newtypes -- but I think we're doomed to do *something* +delicate, as we're really trying to solve for equirecursive type +equality. Bottom line for users: recursive newtypes do not play well with type +inference for representational equality. See also Section 5.3.1 and 5.3.4 of "Safe Zero-cost Coercions for Haskell" (JFP 2016). -Another approach -- which we ultimately decided against -- is described in -Note [Decomposing newtypes a bit more aggressively]. +See also Note [Decomposing newtype equalities]. + +--- Historical side note --- + +We flirted with doing /both/ unwrap-at-top-level /and/ rewrite-deeply; +see #22519. But that didn't work: see discussion in #22924. Specifically +we got a loop with a minor variation: + f2 :: a -> [A] + f2 = coerce Note [Eager reflexivity check] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1492,6 +1466,24 @@ we do a reflexivity check. (This would be sound in the nominal case, but unnecessary, and I [Richard E.] am worried that it would slow down the common case.) + + Note [Newtypes can blow the stack] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have + + newtype X = MkX (Int -> X) + newtype Y = MkY (Int -> Y) + +and now wish to prove + + [W] X ~R Y + +This Wanted will loop, expanding out the newtypes ever deeper looking +for a solid match or a solid discrepancy. Indeed, there is something +appropriate to this looping, because X and Y *do* have the same representation, +in the limit -- they're both (Fix ((->) Int)). However, no finitely-sized +coercion will ever witness it. This loop won't actually cause GHC to hang, +though, because we check our depth in `can_eq_newtype_nc`. -} ------------------------ @@ -1598,8 +1590,7 @@ canEqCast rewritten ev eq_rel swapped ty1 co1 ty2 ps_ty2 role = eqRelRole eq_rel ------------------------ -canTyConApp :: Bool -- True <=> the types have been rewritten - -> CtEvidence -> EqRel +canTyConApp :: CtEvidence -> EqRel -> TyCon -> [TcType] -> TyCon -> [TcType] -> TcS (StopOrContinue Ct) @@ -1607,17 +1598,13 @@ canTyConApp :: Bool -- True <=> the types have been rewritten -- See Note [Decomposing Dependent TyCons and Processing Wanted Equalities] -- Neither tc1 nor tc2 is a saturated funTyCon, nor a type family -- But they can be data families. -canTyConApp rewritten ev eq_rel tc1 tys1 tc2 tys2 +canTyConApp ev eq_rel tc1 tys1 tc2 tys2 | tc1 == tc2 , tys1 `equalLength` tys2 = do { inerts <- getTcSInerts ; if can_decompose inerts then canDecomposableTyConAppOK ev eq_rel tc1 tys1 tys2 - else if rewritten - then canEqFailure ev eq_rel ty1 ty2 - else rewrite_and_try_again ev eq_rel ty1 ty2 } - -- Why rewrite and try again? See Case 1 - -- of Note [Unwrap newtypes first] + else canEqFailure ev eq_rel ty1 ty2 } -- See Note [Skolem abstract data] in GHC.Core.Tycon | tyConSkolem tc1 || tyConSkolem tc2 @@ -1641,7 +1628,7 @@ canTyConApp rewritten ev eq_rel tc1 tys1 tc2 tys2 ty2 = mkTyConApp tc2 tys2 -- See Note [Decomposing TyConApp equalities] - -- Note [Decomposing newtypes a bit more aggressively] + -- and Note [Decomposing newtype equalities] can_decompose inerts = isInjectiveTyCon tc1 (eqRelRole eq_rel) || (assert (eq_rel == ReprEq) $ @@ -1650,7 +1637,8 @@ canTyConApp rewritten ev eq_rel tc1 tys1 tc2 tys2 -- Moreover isInjectiveTyCon is True for Representational -- for algebraic data types. So we are down to newtypes -- and data families. - ctEvFlavour ev == Wanted && noGivenIrreds inerts) + ctEvFlavour ev == Wanted && noGivenNewtypeReprEqs tc1 inerts) + -- See Note [Decomposing newtype equalities] (EX2) {- Note [Use canEqFailure in canDecomposableTyConApp] @@ -1838,13 +1826,13 @@ Example is wrinkle {1} in Note [Decomposing TyConApp equalities]. For a Wanted with r=R, since newtypes are not injective at representational role, decomposition is sound, but we may lose completeness. Nevertheless, -if the newtype is abstraction (so can't be unwrapped) we can only solve +if the newtype is abstract (so can't be unwrapped) we can only solve the equality by (a) using a Given or (b) decomposition. If (a) is impossible -(e.g. no Givens) then (b) is safe. +(e.g. no Givens) then (b) is safe albeit potentially incomplete. -Conclusion: decompose newtypes (at role R) only if there are no usable Givens. +There are two ways in which decomposing (N ty1) ~r (N ty2) could be incomplete: -* Incompleteness example (EX1) +* Incompleteness example (EX1): unwrap first newtype Nt a = MkNt (Id a) type family Id a where Id a = a @@ -1856,39 +1844,68 @@ Conclusion: decompose newtypes (at role R) only if there are no usable Givens. Conclusion: always unwrap newtypes before attempting to decompose them. This is done in can_eq_nc'. Of course, we can't unwrap if the data - constructor isn't in scope. See See Note [Unwrap newtypes first]. + constructor isn't in scope. See Note [Unwrap newtypes first]. -* Incompleteness example (EX2) +* Incompleteness example (EX2): available Givens newtype Nt a = Mk Bool -- NB: a is not used in the RHS, type role Nt representational -- but the user gives it an R role anyway - If we have [W] Nt alpha ~R Nt beta, we *don't* want to decompose to - [W] alpha ~R beta, because it's possible that alpha and beta aren't - representationally equal. + [G] Nt t1 ~R Nt t2 + [W] Nt alpha ~R Nt beta - and maybe there is a Given (Nt t1 ~R Nt t2), just waiting to be used, if we - figure out (elsewhere) that alpha:=t1 and beta:=t2. This is somewhat - similar to the question of overlapping Givens for class constraints: see - Note [Instance and Given overlap] in GHC.Tc.Solver.Interact. + We *don't* want to decompose to [W] alpha ~R beta, because it's possible + that alpha and beta aren't representationally equal. And if we figure + out (elsewhere) that alpha:=t1 and beta:=t2, we can solve the Wanted + from the Given. This is somewhat similar to the question of overlapping + Givens for class constraints: see Note [Instance and Given overlap] in + GHC.Tc.Solver.Interact. Conclusion: don't decompose [W] N s ~R N t, if there are any Given equalities that could later solve it. - But what does "any Given equalities that could later solve it" mean, precisely? - It must be a Given constraint that could turn into N s ~ N t. But that - could include [G] (a b) ~ (c d), or even just [G] c. But it'll definitely - be an CIrredCan. So we settle for having no CIrredCans at all, which is - conservative but safe. See noGivenIrreds and #22331. + But what precisely does it mean to say "any Given equalities that could + later solve it"? + + In #22924 we had + [G] f a ~R# a [W] Const (f a) a ~R# Const a a + where Const is an abstract newtype. If we decomposed the newtype, we + could solve. Not-decomposing on the grounds that (f a ~R# a) might turn + into (Const (f a) a ~R# Const a a) seems a bit silly. + + In #22331 we had + [G] N a ~R# N b [W] N b ~R# N a + (where N is abstract so we can't unwrap). Here we really /don't/ want to + decompose, because the /only/ way to solve the Wanted is from that Given + (with a Sym). + + In #22519 we had + [G] a <= b [W] IO Age ~R# IO Int + + (where IO is abstract so we can't unwrap, and newtype Age = Int; and (<=) + is a type-level comparison on Nats). Here we /must/ decompose, despite the + existence of an Irred Given, or we will simply be stuck. (Side note: We + flirted with deep-rewriting of newtypes (see discussion on #22519 and + !9623) but that turned out not to solve #22924, and also makes type + inference loop more often on recursive newtypes.) + + The currently-implemented compromise is this: + + we decompose [W] N s ~R# N t unless there is a [G] N s' ~ N t' + + that is, a Given Irred equality with both sides headed with N. + See the call to noGivenNewtypeReprEqs in canTyConApp. + + This is not perfect. In principle a Given like [G] (a b) ~ (c d), or + even just [G] c, could later turn into N s ~ N t. But since the free + vars of a Given are skolems, or at least untouchable unification + variables, this is extremely unlikely to happen. - Well not 100.0% safe. There could be a CDictCan with some un-expanded - superclasses; but only in some very obscure recursive-superclass - situations. + Another worry: there could, just, be a CDictCan with some + un-expanded equality superclasses; but only in some very obscure + recursive-superclass situations. -If there are no Irred Givens (which is quite common) then we will -successfuly decompose [W] (IO Age) ~R (IO Int), and solve it. But -that won't happen and [W] (IO Age) ~R (IO Int) will be stuck. -We /could/, however, be a bit more aggressive about decomposition; -see Note [Decomposing newtypes a bit more aggressively]. + Yet another approach (!) is desribed in + Note [Decomposing newtypes a bit more aggressively]. Remember: decomposing Wanteds is always /sound/. This Note is only about /completeness/. @@ -1896,7 +1913,8 @@ only about /completeness/. Note [Decomposing newtypes a bit more aggressively] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ IMPORTANT: the ideas in this Note are *not* implemented. Instead, the -current approach is detailed in Note [Unwrap newtypes first]. +current approach is detailed in Note [Decomposing newtype equalities] +and Note [Unwrap newtypes first]. For more details about the ideas in this Note see * GHC propoosal: https://github.com/ghc-proposals/ghc-proposals/pull/549 * issue #22441 ===================================== compiler/GHC/Tc/Solver/InertSet.hs ===================================== @@ -21,7 +21,7 @@ module GHC.Tc.Solver.InertSet ( addInertItem, noMatchableGivenDicts, - noGivenIrreds, + noGivenNewtypeReprEqs, mightEqualLater, prohibitedSuperClassSolve, @@ -1537,9 +1537,22 @@ isOuterTyVar tclvl tv -- becomes "outer" even though its level numbers says it isn't. | otherwise = False -- Coercion variables; doesn't much matter -noGivenIrreds :: InertSet -> Bool -noGivenIrreds (IS { inert_cans = inert_cans }) - = isEmptyBag (inert_irreds inert_cans) +noGivenNewtypeReprEqs :: TyCon -> InertSet -> Bool +-- True <=> there is no Irred looking like (N tys1 ~ N tys2) +-- See Note [Decomposing newtype equalities] (EX2) in GHC.Tc.Solver.Canonical +-- This is the only call site. +noGivenNewtypeReprEqs tc inerts + = not (anyBag might_help (inert_irreds (inert_cans inerts))) + where + might_help ct + = case classifyPredType (ctPred ct) of + EqPred ReprEq t1 t2 + | Just (tc1,_) <- tcSplitTyConApp_maybe t1 + , tc == tc1 + , Just (tc2,_) <- tcSplitTyConApp_maybe t2 + , tc == tc2 + -> True + _ -> False -- | Returns True iff there are no Given constraints that might, -- potentially, match the given class consraint. This is used when checking to see if a ===================================== compiler/GHC/Tc/Solver/Rewrite.hs ===================================== @@ -42,7 +42,6 @@ import GHC.Builtin.Types (tYPETyCon) import Data.List ( find ) import GHC.Data.List.Infinite (Infinite) import qualified GHC.Data.List.Infinite as Inf -import GHC.Tc.Instance.Family (tcTopNormaliseNewTypeTF_maybe) {- ************************************************************************ @@ -225,10 +224,10 @@ rewrite ev ty ; return result } -- | See Note [Rewriting] --- This variant of 'rewrite' rewrites w.r.t. nominal equality only, --- as this is better than full rewriting for error messages. Specifically, --- we want to avoid unwrapping newtypes, as doing so can end up causing --- an otherwise-unnecessary stack overflow. +-- `rewriteForErrors` is a variant of 'rewrite' that rewrites +-- w.r.t. nominal equality only, as this is better than full rewriting +-- for error messages. (This was important when we flirted with rewriting +-- newtypes but perhaps less so now.) rewriteForErrors :: CtEvidence -> TcType -> TcS (Reduction, RewriterSet) rewriteForErrors ev ty @@ -499,27 +498,14 @@ rewrite_one (TyVarTy tv) rewrite_one (AppTy ty1 ty2) = rewrite_app_tys ty1 [ty2] -rewrite_one ty@(TyConApp tc tys) +rewrite_one (TyConApp tc tys) -- If it's a type family application, try to reduce it | isTypeFamilyTyCon tc = rewrite_fam_app tc tys - | otherwise - = do { eq_rel <- getEqRel - ; if eq_rel == ReprEq - - then -- Rewriting w.r.t. representational equality requires - -- unwrapping newtypes; see GHC.Tc.Solver.Canonical. - -- Note [Unwrap newtypes first] - -- NB: try rewrite_newtype_app even when tc isn't a newtype; - -- the allows the possibility of having a newtype buried under - -- a synonym. Needed for e.g. T12067. - rewrite_newtype_app ty - - else -- For * a normal data type application - -- * data family application - -- we just recursively rewrite the arguments. - rewrite_ty_con_app tc tys } + | otherwise -- We just recursively rewrite the arguments. + -- See Note [Do not rewrite newtypes] + = rewrite_ty_con_app tc tys rewrite_one (FunTy { ft_af = vis, ft_mult = mult, ft_arg = ty1, ft_res = ty2 }) = do { arg_redn <- rewrite_one ty1 @@ -678,42 +664,12 @@ rewrite_vector ki roles tys fvs = tyCoVarsOfType ki {-# INLINE rewrite_vector #-} --- Rewrite a (potential) newtype application --- Precondition: the ambient EqRel is ReprEq --- Precondition: the type is a TyConApp --- See Note [Newtypes can blow the stack] -rewrite_newtype_app :: TcType -> RewriteM Reduction -rewrite_newtype_app ty@(TyConApp tc tys) - = do { rdr_env <- liftTcS getGlobalRdrEnvTcS - ; tf_envs <- liftTcS getFamInstEnvs - ; case (tcTopNormaliseNewTypeTF_maybe tf_envs rdr_env ty) of - Nothing -> -- Non-newtype or abstract newtype - rewrite_ty_con_app tc tys - - Just ((used_ctors, co), ty') -- co :: ty ~ ty' - -> do { liftTcS $ recordUsedGREs used_ctors - ; checkStackDepth ty - ; rewrite_reduction (Reduction co ty') } } - -rewrite_newtype_app other_ty = pprPanic "rewrite_newtype_app" (ppr other_ty) - -{- Note [Newtypes can blow the stack] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Suppose we have - - newtype X = MkX (Int -> X) - newtype Y = MkY (Int -> Y) - -and now wish to prove - - [W] X ~R Y -This Wanted will loop, expanding out the newtypes ever deeper looking -for a solid match or a solid discrepancy. Indeed, there is something -appropriate to this looping, because X and Y *do* have the same representation, -in the limit -- they're both (Fix ((->) Int)). However, no finitely-sized -coercion will ever witness it. This loop won't actually cause GHC to hang, -though, because we check our depth when unwrapping newtypes. +{- Note [Do not rewrite newtypes] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We flirted with unwrapping newtypes in the rewriter -- see GHC.Tc.Solver.Canonical +Note [Unwrap newtypes first]. But that turned out to be a bad idea because +of recursive newtypes, as that Note says. So be careful if you re-add it! Note [Rewriting synonyms] ~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== docs/users_guide/debugging.rst ===================================== @@ -1046,6 +1046,8 @@ Checking for consistency :shortdesc: Align functions at given boundary. :type: dynamic + :since: 8.6.1 + Align functions to multiples of the given value. Only valid values are powers of two. ===================================== docs/users_guide/images/eventlog_profile.png ===================================== Binary files /dev/null and b/docs/users_guide/images/eventlog_profile.png differ ===================================== docs/users_guide/profiling.rst ===================================== @@ -10,17 +10,13 @@ Profiling GHC comes with a time and space profiling system, so that you can answer questions like "why is my program so slow?", or "why is my program using -so much memory?". +so much memory?". We'll start by describing how to do time profiling. -Profiling a program is a three-step process: +Time profiling a program is a three-step process: 1. Re-compile your program for profiling with the :ghc-flag:`-prof` option, and probably one of the options for adding automatic annotations: - :ghc-flag:`-fprof-auto` is the most common [1]_. - - If you are using external packages with :command:`cabal`, you may need to - reinstall these packages with profiling support; typically this is - done with ``cabal install -p package --reinstall``. + :ghc-flag:`-fprof-late` is the recommended option. 2. Having compiled the program for profiling, you now need to run it to generate the profile. For example, a simple time profile can be @@ -37,6 +33,9 @@ Profiling a program is a three-step process: 3. Examine the generated profiling information, use the information to optimise your program, and repeat as necessary. +The time profiler measures the CPU time taken by the Haskell code in your application. +In particular time taken by safe foreign calls is not tracked by the profiler (see :ref:`prof-foreign-calls`). + .. _cost-centres: Cost centres and cost-centre stacks @@ -197,7 +196,10 @@ Inserting cost centres by hand Cost centres are just program annotations. When you say ``-fprof-auto`` to the compiler, it automatically inserts a cost centre annotation around every binding not marked INLINE in your program, but you are -entirely free to add cost centre annotations yourself. +entirely free to add cost centre annotations yourself. Be careful adding too many +cost-centre annotations as the optimiser is careful to not move them around or +remove them, which can severly affect how your program is optimised and hence the +runtime performance! The syntax of a cost centre annotation for expressions is :: @@ -311,6 +313,39 @@ and become CAFs. You will probably need to consult the Core .. index:: single: -fprof-cafs +.. _prof-foreign-calls: + +Profiling and foreign calls +--------------------------- + +Simply put, the profiler includes time spent in unsafe foreign +calls but ignores time taken in safe foreign calls. For example, time spent blocked on IO +operations (e.g. ``getLine``) is not accounted for in the profile as ``getLine`` is implemented +using a safe foreign call. + +The profiler estimates CPU time, for Haskell threads within the program only. +In particular, time "taken" by the program in blocking safe foreign calls +is not accounted for in time profiles. The runtime has the notion of a virtual +processor which is known as a "capability". Haskell threads are run on capabilities, +and the profiler samples the capabilities in order to determine what is being +executed at a certain time. When a safe foreign call is executed, it's run outside +the context of a capability; hence the sampling does not account for the time +taken. Whilst the safe call is executed, other +Haskell threads are free to run on the capability, and their cost will be attributed +to the profiler. When the safe call is finished, the blocked, descheduled thread can +be resumed and rescheduled. + +However, the time taken by blocking on unsafe foreign calls is accounted for in the profile. +This happens because unsafe foreign calls are executed by the same capability +their calling Haskell thread is running on. Therefore, an unsafe foreign call will +block the entire capability whilst it is running, and any time the capability is +sampled the "cost" of the foreign call will be attributed to the calling cost-centre stack. + +However, do note that you are not supposed to use unsafe foreign calls for any +operations which do block! Do not be tempted to replace your safe foreign calls +with unsafe calls just so they appear in the profile. This prevents GC from +happening until the foreign call returns, which can be catastrophic for performance. + .. _prof-compiler-options: Compiler options for profiling @@ -356,7 +391,9 @@ Automatically placing cost-centres ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ GHC has a number of flags for automatically inserting cost-centres into the -compiled program. +compiled program. Use these options carefully because inserting too many cost-centres +in the wrong places will mean the optimiser will be less effective and the runtime behaviour +of your profiled program will be different to that of the unprofiled one. .. ghc-flag:: -fprof-callers=⟨name⟩ :shortdesc: Auto-add ``SCC``\\ s to all call-sites of the named function. @@ -618,8 +655,10 @@ enclosed between ``+RTS ... -RTS`` as usual): JSON profile format ~~~~~~~~~~~~~~~~~~~ -When invoked with the :rts-flag:`-pj` flag the runtime will emit the cost-centre -profile in a machine-readable JSON format. The top-level object of this format +profile in a machine-readable JSON format. The JSON file can be directly loaded +into `speedscope.app `_ to interactively view the profile. + +The top-level object of this format has the following properties, ``program`` (string) @@ -758,8 +797,12 @@ For instance, a simple profile might look like this, } } +Eventlog profile format +~~~~~~~~~~~~~~~~~~~~~~~ - +In addition to the ``.prof`` and ``.json`` formats the cost centre definitions +and samples are also emitted to the :ref:`eventlog `. The format +of the events is specified in the :ref:`eventlog encodings ` section. .. _prof-heap: @@ -774,18 +817,35 @@ program holds on to more memory at run-time that it needs to. Space leaks lead to slower execution due to heavy garbage collector activity, and may even cause the program to run out of memory altogether. +Heap profiling differs from time profiling in the fact that is not always +necessary to use the profiling runtime to generate a heap profile. There +are two heap profiling modes (:rts-flag:`-hT` and :rts-flag:`-hi` [1]_) which are always +available. + To generate a heap profile from your program: -1. Compile the program for profiling (:ref:`prof-compiler-options`). +1. Assuming you need the profiling runtime, compile the program for profiling (:ref:`prof-compiler-options`). 2. Run it with one of the heap profiling options described below (eg. - :rts-flag:`-hc` for a basic producer profile). This generates the file - :file:`{prog}.hp`. + :rts-flag:`-hc` for a basic producer profile) and enable the eventlog using :rts-flag:`-l <-l ⟨flags⟩>`. - If the :ref:`event log ` is enabled (with the :rts-flag:`-l ⟨flags⟩` - runtime system flag) heap samples will additionally be emitted to the GHC + Heap samples will be emitted to the GHC event log (see :ref:`heap-profiler-events` for details about event format). +3. Render the heap profile using `eventlog2html `_. + This produces an HTML file which contains the visualised profile. + +4. Open the rendered interactive profile in your web browser. + +For example, here is a heap profile produced of using eventlog profiling on GHC +compiling the Cabal library. You can read a lot more about eventlog2html on the website. + +.. image:: images/eventlog_profile.* + +Note that there is the legacy :file:`{prog}.hp` format which has been deprecated +in favour of eventlog based profiling. In order to render the legacy format, the +steps are as follows. + 3. Run :command:`hp2ps` to produce a Postscript file, :file:`{prog}.ps`. The :command:`hp2ps` utility is described in detail in :ref:`hp2ps`. @@ -797,10 +857,6 @@ from GHC's ``nofib`` benchmark suite, .. image:: images/prof_scc.* -You might also want to take a look at -`hp2any `__, a more advanced -suite of tools (not distributed with GHC) for displaying heap profiles. - Note that there might be a big difference between the OS reported memory usage of your program and the amount of live data as reported by heap profiling. The reasons for the difference are explained in :ref:`hints-os-memory`. @@ -817,20 +873,14 @@ following RTS options select which break-down to use: .. rts-flag:: -hT - Breaks down the graph by heap closure type. + Breaks down the graph by heap closure type. This does not require the profiling + runtime. .. rts-flag:: -hc - -h *Requires* :ghc-flag:`-prof`. Breaks down the graph by the cost-centre stack which produced the data. - .. note:: The meaning of the shortened :rts-flag:`-h` is dependent on whether - your program was compiled for profiling. When compiled for profiling, - :rts-flag:`-h` is equivalent to :rts-flag:`-hc`, but otherwise is - equivalent to :rts-flag:`-hT` (see :ref:`rts-profiling`). The :rts-flag:`-h` - is deprecated and will be removed in a future release. - .. rts-flag:: -hm *Requires* :ghc-flag:`-prof`. Break down the live heap by the module @@ -863,7 +913,7 @@ following RTS options select which break-down to use: Break down the graph by the address of the info table of a closure. For this to produce useful output the program must have been compiled with - :ghc-flag:`-finfo-table-map`. + :ghc-flag:`-finfo-table-map` but it does not require the profiling runtime. .. rts-flag:: -l :noindex: @@ -1041,6 +1091,14 @@ This trick isn't foolproof, because there might be other ``B`` closures in the heap which aren't the retainers we are interested in, but we've found this to be a useful technique in most cases. +Precise Retainer Analysis +~~~~~~~~~~~~~~~~~~~~~~~~~ + +If you want to precisely answer questions about why a certain type of closure is +retained then it is worthwhile using `ghc-debug `_ which +has a terminal interface which can be used to easily answer queries such as, what is retaining +a certain closure. + .. _biography-prof: Biographical Profiling @@ -1120,6 +1178,9 @@ reasons for this: allocated by foreign libraries, and data allocated by the RTS), and ``mmap()``\'d memory are not counted in the heap profile. +For more discussion about understanding how understanding process residency see +:ref:`hints-os-memory`. + .. _hp2ps: ``hp2ps`` -- Rendering heap profiles to PostScript @@ -1242,123 +1303,6 @@ The flags are: Print out usage information. -.. _manipulating-hp: - -Manipulating the ``hp`` file -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -(Notes kindly offered by Jan-Willem Maessen.) - -The ``FOO.hp`` file produced when you ask for the heap profile of a -program ``FOO`` is a text file with a particularly simple structure. -Here's a representative example, with much of the actual data omitted: - -.. code-block:: none - - JOB "FOO -hC" - DATE "Thu Dec 26 18:17 2002" - SAMPLE_UNIT "seconds" - VALUE_UNIT "bytes" - BEGIN_SAMPLE 0.00 - END_SAMPLE 0.00 - BEGIN_SAMPLE 15.07 - ... sample data ... - END_SAMPLE 15.07 - BEGIN_SAMPLE 30.23 - ... sample data ... - END_SAMPLE 30.23 - ... etc. - BEGIN_SAMPLE 11695.47 - END_SAMPLE 11695.47 - -The first four lines (``JOB``, ``DATE``, ``SAMPLE_UNIT``, -``VALUE_UNIT``) form a header. Each block of lines starting with -``BEGIN_SAMPLE`` and ending with ``END_SAMPLE`` forms a single sample -(you can think of this as a vertical slice of your heap profile). The -hp2ps utility should accept any input with a properly-formatted header -followed by a series of *complete* samples. - -Zooming in on regions of your profile -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -You can look at particular regions of your profile simply by loading a -copy of the ``.hp`` file into a text editor and deleting the unwanted -samples. The resulting ``.hp`` file can be run through ``hp2ps`` and -viewed or printed. - -Viewing the heap profile of a running program -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -The ``.hp`` file is generated incrementally as your program runs. In -principle, running :command:`hp2ps` on the incomplete file should produce a -snapshot of your program's heap usage. However, the last sample in the -file may be incomplete, causing :command:`hp2ps` to fail. If you are using a -machine with UNIX utilities installed, it's not too hard to work around -this problem (though the resulting command line looks rather Byzantine): - -.. code-block:: sh - - head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \ - | hp2ps > FOO.ps - -The command ``fgrep -n END_SAMPLE FOO.hp`` finds the end of every -complete sample in ``FOO.hp``, and labels each sample with its ending -line number. We then select the line number of the last complete sample -using :command:`tail` and :command:`cut`. This is used as a parameter to :command:`head`; the -result is as if we deleted the final incomplete sample from :file:`FOO.hp`. -This results in a properly-formatted .hp file which we feed directly to -:command:`hp2ps`. - -Viewing a heap profile in real time -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -The :command:`gv` and :command:`ghostview` programs have a "watch file" option -can be used to view an up-to-date heap profile of your program as it runs. -Simply generate an incremental heap profile as described in the previous -section. Run :command:`gv` on your profile: - -.. code-block:: sh - - gv -watch -orientation=seascape FOO.ps - -If you forget the ``-watch`` flag you can still select "Watch file" from -the "State" menu. Now each time you generate a new profile ``FOO.ps`` -the view will update automatically. - -This can all be encapsulated in a little script: - -.. code-block:: sh - - #!/bin/sh - head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \ - | hp2ps > FOO.ps - gv -watch -orientation=seascape FOO.ps & - while [ 1 ] ; do - sleep 10 # We generate a new profile every 10 seconds. - head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \ - | hp2ps > FOO.ps - done - -Occasionally :command:`gv` will choke as it tries to read an incomplete copy of -:file:`FOO.ps` (because :command:`hp2ps` is still running as an update occurs). A -slightly more complicated script works around this problem, by using the -fact that sending a SIGHUP to gv will cause it to re-read its input -file: - -.. code-block:: sh - - #!/bin/sh - head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \ - | hp2ps > FOO.ps - gv FOO.ps & - gvpsnum=$! - while [ 1 ] ; do - sleep 10 - head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \ - | hp2ps > FOO.ps - kill -HUP $gvpsnum - done - .. _prof-threaded: Profiling Parallel and Concurrent Programs @@ -1968,10 +1912,9 @@ Notes about ticky profiling in some columns. For this reason using an eventlog-based approach should be prefered if possible. - .. [1] - :ghc-flag:`-fprof-auto` was known as ``-auto-all`` prior to - GHC 7.4.1. + :rts-flag:`-hi` profiling is avaible with the normal runtime but you will need to + compile with :ghc-flag:`-finfo-table-map` to interpret the results. .. [2] Note that this policy has changed slightly in GHC 7.4.1 relative to ===================================== testsuite/tests/typecheck/should_compile/T22924.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE FlexibleInstances #-} +module G where + +import Data.Functor.Const( Const ) +import Data.Coerce + +f :: Coercible (f a) a => Const a () -> Const (f a) () +f = coerce + ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -857,3 +857,4 @@ test('T22647', normal, compile, ['']) test('T19577', normal, compile, ['']) test('T22383', normal, compile, ['']) test('T21501', normal, compile, ['']) +test('T22924', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T22924a.hs ===================================== @@ -0,0 +1,9 @@ +module T22924a where + +import Data.Coerce + +newtype R = MkR [R] + +f :: a -> [R] +-- Should give a civilised error +f = coerce ===================================== testsuite/tests/typecheck/should_fail/T22924a.stderr ===================================== @@ -0,0 +1,11 @@ + +T22924a.hs:9:5: error: [GHC-10283] + • Couldn't match representation of type ‘a’ with that of ‘[R]’ + arising from a use of ‘coerce’ + ‘a’ is a rigid type variable bound by + the type signature for: + f :: forall a. a -> [R] + at T22924a.hs:7:1-13 + • In the expression: coerce + In an equation for ‘f’: f = coerce + • Relevant bindings include f :: a -> [R] (bound at T22924a.hs:9:1) ===================================== testsuite/tests/typecheck/should_fail/T22924b.hs ===================================== @@ -0,0 +1,10 @@ +module T22924b where + +import Data.Coerce + +newtype R = MkR [R] +newtype S = MkS [S] + +f :: R -> S +-- Blows the typechecker reduction stack +f = coerce ===================================== testsuite/tests/typecheck/should_fail/T22924b.stderr ===================================== @@ -0,0 +1,10 @@ + +T22924b.hs:10:5: error: + • Reduction stack overflow; size = 201 + When simplifying the following type: R + Use -freduction-depth=0 to disable this check + (any upper bound you could choose might fail unpredictably with + minor updates to GHC, so disabling the check is recommended if + you're sure that type checking should terminate) + • In the expression: coerce + In an equation for ‘f’: f = coerce ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -667,3 +667,5 @@ test('T22570', normal, compile_fail, ['']) test('T22645', normal, compile_fail, ['']) test('T20666', normal, compile_fail, ['']) test('T20666a', normal, compile_fail, ['']) +test('T22924a', normal, compile_fail, ['']) +test('T22924b', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bc08cdb67f416494b3c920a50fedb0b1942e0fda...2b0d4d28537988cc304ffb5c292455c8492c793e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bc08cdb67f416494b3c920a50fedb0b1942e0fda...2b0d4d28537988cc304ffb5c292455c8492c793e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Feb 13 22:43:08 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 13 Feb 2023 17:43:08 -0500 Subject: [Git][ghc/ghc][wip/rts-warnings] 26 commits: Fix tyvar scoping within class SPECIALISE pragmas Message-ID: <63eabcfcf1a16_26da844889a24363563@gitlab.mail> Ben Gamari pushed to branch wip/rts-warnings at Glasgow Haskell Compiler / GHC Commits: 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - a23f052f by Ben Gamari at 2023-02-13T17:39:38-05:00 rts/ipe: Fix unused lock warning - - - - - 7b45731d by Ben Gamari at 2023-02-13T17:39:38-05:00 rts/ProfilerReportJson: Fix memory leak - - - - - f675d80d by Ben Gamari at 2023-02-13T17:39:38-05:00 rts: Various warnings fixes - - - - - 8bc60282 by Ben Gamari at 2023-02-13T17:39:38-05:00 rts: Fix printf format mismatch - - - - - cad80eba by Ben Gamari at 2023-02-13T17:39:38-05:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - 3d38c939 by Ben Gamari at 2023-02-13T17:39:38-05:00 nonmoving: Fix unused definition warrnings - - - - - 66607123 by Ben Gamari at 2023-02-13T17:42:25-05:00 Disable futimens on Darwin. See #22938 - - - - - 0d05a772 by Ben Gamari at 2023-02-13T17:42:25-05:00 rts: Fix incorrect CPP guard - - - - - b9849d7a by Ben Gamari at 2023-02-13T17:42:28-05:00 hadrian: Ensure that -Werror is passed when compiling the RTS. Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler when building the RTS. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. I tried to enable `-Werror` in all C compilations but the boot libraries are something of a portability nightmare. - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Rename/Bind.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Unit/Module/ModIface.hs - docs/users_guide/debugging.rst - + docs/users_guide/images/eventlog_profile.png - docs/users_guide/profiling.rst - hadrian/src/Flavour.hs - libraries/base/Data/OldList.hs - libraries/base/tests/all.T - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - libraries/template-haskell/changelog.md - libraries/transformers The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e63d0cb85962f006989ab0902b9b5b38ee9a47f7...b9849d7af13175e4d5b58706dfeeffd16ab2325f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e63d0cb85962f006989ab0902b9b5b38ee9a47f7...b9849d7af13175e4d5b58706dfeeffd16ab2325f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 01:13:21 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 13 Feb 2023 20:13:21 -0500 Subject: [Git][ghc/ghc][wip/ci-interface-stability] 130 commits: Hadrian: correctly detect AR at-file support Message-ID: <63eae031687db_26da8449bc608368081@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 1bd32a35 by Sylvain Henry at 2023-01-26T12:34:21-05:00 Factorize hptModulesBelow Create and use moduleGraphModulesBelow in GHC.Unit.Module.Graph that doesn't need anything from the driver to be used. - - - - - 1262d3f8 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Store dehydrated data structures in CgModBreaks This fixes a tricky leak in GHCi where we were retaining old copies of HscEnvs when reloading. If not all modules were recompiled then these hydrated fields in break points would retain a reference to the old HscEnv which could double memory usage. Fixes #22530 - - - - - e27eb80c by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force more in NFData Name instance Doesn't force the lazy `OccName` field (#19619) which is already known as a really bad source of leaks. When we slam the hammer storing Names on disk (in interface files or the like), all this should be forced as otherwise a `Name` can easily retain an `Id` and hence the entire world. Fixes #22833 - - - - - 3d004d5a by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force OccName in tidyTopName This occname has just been derived from an `Id`, so need to force it promptly so we can release the Id back to the world. Another symptom of the bug caused by #19619 - - - - - f2a0fea0 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Strict fields in ModNodeKey (otherwise retains HomeModInfo) Towards #22530 - - - - - 5640cb1d by Sylvain Henry at 2023-01-26T12:35:36-05:00 Hadrian: fix doc generation Was missing dependencies on files generated by templates (e.g. ghc.cabal) - - - - - 3e827c3f by Richard Eisenberg at 2023-01-26T20:06:53-05:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. - - - - - b3ef5c89 by doyougnu at 2023-01-26T20:07:48-05:00 tryFillBuffer: strictify more speculative bangs - - - - - d0d7ba0f by Vladislav Zavialov at 2023-01-26T20:08:25-05:00 base: NoImplicitPrelude in Data.Void and Data.Kind This change removes an unnecessary dependency on Prelude from two modules in the base package. - - - - - fa1db923 by Matthew Pickering at 2023-01-26T20:09:00-05: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 - - - - - 807310a1 by Matthew Pickering at 2023-01-26T20:09:00-05:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. - - - - - c7116b10 by Ben Gamari at 2023-01-26T20:09:35-05:00 base: Make changelog proposal references more consistent Addresses #22773. - - - - - 6932cfc7 by Sylvain Henry at 2023-01-26T20:10:27-05:00 Fix spurious change from !9568 - - - - - e480fbc2 by Ben Gamari at 2023-01-27T05:01:24-05:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 - - - - - 2648c09c by Andrei Borzenkov at 2023-01-27T05:02:07-05:00 Replace errors from badOrigBinding with new one (#22839) Problem: in 02279a9c the type-level [] syntax was changed from a built-in name to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if a name is not built-in then it must have come from TH quotation, but this is not necessarily the case with []. The outdated assumption in badOrigBinding leads to incorrect error messages. This code: data [] Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []" Unfortunately, there is not enough information in RdrName to directly determine if the name was constructed via TH or by the parser, so this patch changes the error message instead. It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote into a new error TcRnBindingOfExistingName and changes its wording to avoid guessing the origin of the name. - - - - - 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - e4e3caf8 by Ben Gamari at 2023-02-13T20:13:09-05:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - cabal.project-reinstall - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Reg.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/BlockLayout.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4e93a72047696bc8c4b2053a986f37617ab92702...e4e3caf8415d00b0f69716785222068bb37f5b45 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4e93a72047696bc8c4b2053a986f37617ab92702...e4e3caf8415d00b0f69716785222068bb37f5b45 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 02:36:24 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Mon, 13 Feb 2023 21:36:24 -0500 Subject: [Git][ghc/ghc][wip/unboxed-codebuffer] 11 commits: Update `Data.List.singleton` doc comment Message-ID: <63eaf3a8cc4d9_26da8448900b83993a6@gitlab.mail> Josh Meredith pushed to branch wip/unboxed-codebuffer at Glasgow Haskell Compiler / GHC Commits: d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 1fa926ef by Josh Meredith at 2023-02-14T02:36:20+00:00 CodeBuffer: change to use unboxed tuples for encoders/decoders Updates submodules for filepath and haskeline - - - - - 30 changed files: - .gitlab/merge_request_templates/merge-request.md - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Unit/Module/ModIface.hs - docs/users_guide/debugging.rst - + docs/users_guide/images/eventlog_profile.png - docs/users_guide/profiling.rst - libraries/base/Data/OldList.hs - libraries/base/GHC/IO/Encoding.hs - libraries/base/GHC/IO/Encoding/Failure.hs - libraries/base/GHC/IO/Encoding/Iconv.hs - libraries/base/GHC/IO/Encoding/Latin1.hs - libraries/base/GHC/IO/Encoding/Types.hs - libraries/base/GHC/IO/Encoding/UTF16.hs - libraries/base/GHC/IO/Encoding/UTF32.hs - libraries/base/GHC/IO/Encoding/UTF8.hs - libraries/base/GHC/IO/Handle/Internals.hs - libraries/base/tests/all.T - libraries/filepath - libraries/haskeline - libraries/template-haskell/Language/Haskell/TH/Syntax.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/14a8af2057477fff528b58eade83ed527fda2197...1fa926ef9781b25f96961d73473088dd4a97ba65 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/14a8af2057477fff528b58eade83ed527fda2197...1fa926ef9781b25f96961d73473088dd4a97ba65 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 02:55:07 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 13 Feb 2023 21:55:07 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 14 commits: Add clangd flag to include generated header files Message-ID: <63eaf80b678ed_26da8449bc6d04174ef@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f90976c2 by Sven Tennie at 2023-02-13T21:53:53-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - d173971c by amesgen at 2023-02-13T21:53:57-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - f9cbc354 by Ben Gamari at 2023-02-13T21:53:58-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - 16e3096b by Oleg Grenrus at 2023-02-13T21:54:02-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - f9b08580 by PHO at 2023-02-13T21:54:04-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 69393067 by PHO at 2023-02-13T21:54:07-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - e3ababb5 by Li-yao Xia at 2023-02-13T21:54:10-05:00 base: Move changelog entry to its place - - - - - 7adffc85 by Ben Gamari at 2023-02-13T21:54:11-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - 0de5c091 by Andreas Klebinger at 2023-02-13T21:54:12-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9cc12342 by sheaf at 2023-02-13T21:54:15-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - bf972c34 by Cheng Shao at 2023-02-13T21:54:16-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 56b428bb by Simon Hengel at 2023-02-13T21:54:18-05:00 Update outdated references to notes - - - - - f7436bf4 by meooow25 at 2023-02-13T21:54:21-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - ab846625 by Cheng Shao at 2023-02-13T21:54:23-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 30 changed files: - .gitlab/rel_eng/upload_ghc_libs.py - compile_flags.txt - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Driver/Config/Stg/Pipeline.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Types.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Origin.hs-boot - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Fixity.hs - compiler/GHC/Types/ForeignCall.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3f91bc4ea25ba19932c06fc44c28b9aca4e7262c...ab8466253adec59a2ff0e1aaf3000465a08511bc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3f91bc4ea25ba19932c06fc44c28b9aca4e7262c...ab8466253adec59a2ff0e1aaf3000465a08511bc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 04:54:26 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Mon, 13 Feb 2023 23:54:26 -0500 Subject: [Git][ghc/ghc][wip/js-rts-fixmes] 8 commits: Refresh profiling docs Message-ID: <63eb1402dd0d9_26da8449bc6a84415c4@gitlab.mail> Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC Commits: 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 2e2a7f5e by Josh Meredith at 2023-02-14T04:54:01+00:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} - - - - - a2319f3c by Josh Meredith at 2023-02-14T04:54:01+00:00 Cache names used commonly in JS backend RTS generation - - - - - 0ea1d661 by Sylvain Henry at 2023-02-14T04:54:01+00:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 3c73b0d1 by Josh Meredith at 2023-02-14T04:54:01+00:00 JS/Make: reduce cache sizes - - - - - c33a70fc by Josh Meredith at 2023-02-14T04:54:01+00:00 JS RTS: use jsClosureCount for closureConstructors and cache sizes - - - - - 7 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Rts/Rts.hs - docs/users_guide/debugging.rst - + docs/users_guide/images/eventlog_profile.png - docs/users_guide/profiling.rst Changes: ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -129,7 +129,11 @@ module GHC.JS.Make -- * Miscellaneous -- $misc , allocData, allocClsA - , dataFieldName, dataFieldNames + , dataName + , clsName + , dataFieldName + , varName + , jsClosureCount ) where @@ -142,10 +146,8 @@ import Control.Arrow ((***)) import Data.Array import qualified Data.Map as M -import GHC.Utils.Outputable (Outputable (..)) import GHC.Data.FastString import GHC.Utils.Monad.State.Strict -import GHC.Utils.Panic import GHC.Utils.Misc import GHC.Types.Unique.Map @@ -642,30 +644,48 @@ dataFieldCache :: Array Int FastString dataFieldCache = listArray (0,nFieldCache) (map (mkFastString . ('d':) . show) [(0::Int)..nFieldCache]) nFieldCache :: Int -nFieldCache = 16384 +nFieldCache = 255 + +jsClosureCount :: Int +jsClosureCount = 24 dataFieldName :: Int -> FastString dataFieldName i - | i < 1 || i > nFieldCache = panic "dataFieldName" (ppr i) + | i < 0 || i > nFieldCache = mkFastString ('d' : show i) | otherwise = dataFieldCache ! i -dataFieldNames :: [FastString] -dataFieldNames = fmap dataFieldName [1..nFieldCache] - - -- | Cache "h$dXXX" names dataCache :: Array Int FastString -dataCache = listArray (0,1024) (map (mkFastString . ("h$d"++) . show) [(0::Int)..1024]) +dataCache = listArray (0,jsClosureCount) (map (mkFastString . ("h$d"++) . show) [(0::Int)..jsClosureCount]) + +dataName :: Int -> FastString +dataName i + | i < 0 || i > nFieldCache = mkFastString ("h$d" ++ show i) + | otherwise = dataCache ! i allocData :: Int -> JExpr -allocData i = toJExpr (TxtI (dataCache ! i)) +allocData i = toJExpr (TxtI (dataName i)) -- | Cache "h$cXXX" names clsCache :: Array Int FastString -clsCache = listArray (0,1024) (map (mkFastString . ("h$c"++) . show) [(0::Int)..1024]) +clsCache = listArray (0,jsClosureCount) (map (mkFastString . ("h$c"++) . show) [(0::Int)..jsClosureCount]) + +clsName :: Int -> FastString +clsName i + | i < 0 || i > jsClosureCount = mkFastString ("h$c" ++ show i) + | otherwise = clsCache ! i allocClsA :: Int -> JExpr -allocClsA i = toJExpr (TxtI (clsCache ! i)) +allocClsA i = toJExpr (TxtI (clsName i)) + +-- | Cache "xXXX" names +varCache :: Array Int Ident +varCache = listArray (0,jsClosureCount) (map (TxtI . mkFastString . ('x':) . show) [(0::Int)..jsClosureCount]) + +varName :: Int -> Ident +varName i + | i < 0 || i > jsClosureCount = TxtI $ mkFastString ('x' : show i) + | otherwise = varCache ! i -------------------------------------------------------------------------------- ===================================== compiler/GHC/StgToJS/DataCon.hs ===================================== @@ -97,7 +97,7 @@ allocDynamicE :: Bool -- ^ csInlineAlloc from StgToJSConfig -> Maybe JExpr -> JExpr allocDynamicE inline_alloc entry free cc - | inline_alloc || length free > 24 = newClosure $ Closure + | inline_alloc || length free > jsClosureCount = newClosure $ Closure { clEntry = entry , clField1 = fillObj1 , clField2 = fillObj2 ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -1006,7 +1006,7 @@ allocDynAll haveDecl middle cls = do ] (ex:es) -> mconcat [ toJExpr i .^ closureField1_ |= toJExpr ex - , toJExpr i .^ closureField2_ |= toJExpr (jhFromList (zip dataFieldNames es)) + , toJExpr i .^ closureField2_ |= toJExpr (jhFromList (zip (map dataFieldName [1..]) es)) ] | otherwise = case es of [] -> mempty ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -81,36 +81,8 @@ resetResultVar r = toJExpr r |= null_ -- JIT can optimize better. closureConstructors :: StgToJSConfig -> JStat closureConstructors s = BlockStat - [ declClsConstr "h$c" ["f"] $ Closure - { clEntry = var "f" - , clField1 = null_ - , clField2 = null_ - , clMeta = 0 - , clCC = ccVal - } - , declClsConstr "h$c0" ["f"] $ Closure - { clEntry = var "f" - , clField1 = null_ - , clField2 = null_ - , clMeta = 0 - , clCC = ccVal - } - , declClsConstr "h$c1" ["f", "x1"] $ Closure - { clEntry = var "f" - , clField1 = var "x1" - , clField2 = null_ - , clMeta = 0 - , clCC = ccVal - } - , declClsConstr "h$c2" ["f", "x1", "x2"] $ Closure - { clEntry = var "f" - , clField1 = var "x1" - , clField2 = var "x2" - , clMeta = 0 - , clCC = ccVal - } - , mconcat (map mkClosureCon [3..24]) - , mconcat (map mkDataFill [1..24]) + [ mconcat (map mkClosureCon (Nothing : map Just [0..jsClosureCount])) + , mconcat (map mkDataFill [1..jsClosureCount]) ] where prof = csProf s @@ -118,19 +90,8 @@ closureConstructors s = BlockStat -- the cc argument happens to be named just like the cc field... | prof = ([TxtI closureCC_], Just (var closureCC_)) | otherwise = ([], Nothing) - addCCArg as = map TxtI as ++ ccArg addCCArg' as = as ++ ccArg - declClsConstr i as cl = TxtI i ||= ValExpr (JFunc (addCCArg as) - ( jVar $ \x -> - [ checkC - , x |= newClosure cl - , notifyAlloc x - , traceAlloc x - , returnS x - ] - )) - traceAlloc x | csTraceRts s = appS "h$traceAlloc" [x] | otherwise = mempty @@ -172,26 +133,36 @@ closureConstructors s = BlockStat | otherwise = mempty - mkClosureCon :: Int -> JStat - mkClosureCon n = funName ||= toJExpr fun + mkClosureCon :: Maybe Int -> JStat + mkClosureCon n0 = funName ||= toJExpr fun where - funName = TxtI $ mkFastString ("h$c" ++ show n) + n | Just n' <- n0 = n' + | Nothing <- n0 = 0 + funName | Just n' <- n0 = TxtI $ clsName n' + | Nothing <- n0 = TxtI $ mkFastString "h$c" -- args are: f x1 x2 .. xn [cc] - args = TxtI "f" : addCCArg' (map (TxtI . mkFastString . ('x':) . show) [(1::Int)..n]) + args = TxtI "f" : addCCArg' (map varName [1..n]) fun = JFunc args funBod -- x1 goes into closureField1. All the other args are bundled into an -- object in closureField2: { d1 = x2, d2 = x3, ... } -- - extra_args = ValExpr . JHash . listToUniqMap $ zip - (map (mkFastString . ('d':) . show) [(1::Int)..]) - (map (toJExpr . TxtI . mkFastString . ('x':) . show) [2..n]) + vars = map (toJExpr . varName) [1..n] + + x1 = case vars of + [] -> null_ + x:_ -> x + x2 = case vars of + [] -> null_ + [_] -> null_ + [_,x] -> x + _:x:xs -> ValExpr . JHash . listToUniqMap $ zip (map dataFieldName [1..]) (x:xs) funBod = jVar $ \x -> [ checkC , x |= newClosure Closure { clEntry = var "f" - , clField1 = var "x1" - , clField2 = extra_args + , clField1 = x1 + , clField2 = x2 , clMeta = 0 , clCC = ccVal } @@ -203,8 +174,8 @@ closureConstructors s = BlockStat mkDataFill :: Int -> JStat mkDataFill n = funName ||= toJExpr fun where - funName = TxtI $ mkFastString ("h$d" ++ show n) - ds = map (mkFastString . ('d':) . show) [(1::Int)..n] + funName = TxtI $ dataName n + ds = map dataFieldName [1..n] extra_args = ValExpr . JHash . listToUniqMap . zip ds $ map (toJExpr . TxtI) ds fun = JFunc (map TxtI ds) (checkD <> returnS extra_args) @@ -215,7 +186,7 @@ stackManip = mconcat (map mkPush [1..32]) <> where mkPush :: Int -> JStat mkPush n = let funName = TxtI $ mkFastString ("h$p" ++ show n) - as = map (TxtI . mkFastString . ('x':) . show) [1..n] + as = map varName [1..n] fun = JFunc as ((sp |= sp + toJExpr n) <> mconcat (zipWith (\i a -> stack .! (sp - toJExpr (n-i)) |= toJExpr a) [1..] as)) @@ -228,7 +199,7 @@ stackManip = mconcat (map mkPush [1..32]) <> bits = bitsIdx sig n = length bits h = last bits - args = map (TxtI . mkFastString . ('x':) . show) [1..n] + args = map varName [1..n] fun = JFunc args $ mconcat [ sp |= sp + toJExpr (h+1) , mconcat (zipWith (\b a -> stack .! (sp - toJExpr (h-b)) |= toJExpr a) bits args) @@ -288,7 +259,7 @@ loadRegs :: JStat loadRegs = mconcat $ map mkLoad [1..32] where mkLoad :: Int -> JStat - mkLoad n = let args = map (TxtI . mkFastString . ("x"++) . show) [1..n] + mkLoad n = let args = map varName [1..n] assign = zipWith (\a r -> toJExpr r |= toJExpr a) args (reverse $ take n regsFromR1) fname = TxtI $ mkFastString ("h$l" ++ show n) ===================================== docs/users_guide/debugging.rst ===================================== @@ -1046,6 +1046,8 @@ Checking for consistency :shortdesc: Align functions at given boundary. :type: dynamic + :since: 8.6.1 + Align functions to multiples of the given value. Only valid values are powers of two. ===================================== docs/users_guide/images/eventlog_profile.png ===================================== Binary files /dev/null and b/docs/users_guide/images/eventlog_profile.png differ ===================================== docs/users_guide/profiling.rst ===================================== @@ -10,17 +10,13 @@ Profiling GHC comes with a time and space profiling system, so that you can answer questions like "why is my program so slow?", or "why is my program using -so much memory?". +so much memory?". We'll start by describing how to do time profiling. -Profiling a program is a three-step process: +Time profiling a program is a three-step process: 1. Re-compile your program for profiling with the :ghc-flag:`-prof` option, and probably one of the options for adding automatic annotations: - :ghc-flag:`-fprof-auto` is the most common [1]_. - - If you are using external packages with :command:`cabal`, you may need to - reinstall these packages with profiling support; typically this is - done with ``cabal install -p package --reinstall``. + :ghc-flag:`-fprof-late` is the recommended option. 2. Having compiled the program for profiling, you now need to run it to generate the profile. For example, a simple time profile can be @@ -37,6 +33,9 @@ Profiling a program is a three-step process: 3. Examine the generated profiling information, use the information to optimise your program, and repeat as necessary. +The time profiler measures the CPU time taken by the Haskell code in your application. +In particular time taken by safe foreign calls is not tracked by the profiler (see :ref:`prof-foreign-calls`). + .. _cost-centres: Cost centres and cost-centre stacks @@ -197,7 +196,10 @@ Inserting cost centres by hand Cost centres are just program annotations. When you say ``-fprof-auto`` to the compiler, it automatically inserts a cost centre annotation around every binding not marked INLINE in your program, but you are -entirely free to add cost centre annotations yourself. +entirely free to add cost centre annotations yourself. Be careful adding too many +cost-centre annotations as the optimiser is careful to not move them around or +remove them, which can severly affect how your program is optimised and hence the +runtime performance! The syntax of a cost centre annotation for expressions is :: @@ -311,6 +313,39 @@ and become CAFs. You will probably need to consult the Core .. index:: single: -fprof-cafs +.. _prof-foreign-calls: + +Profiling and foreign calls +--------------------------- + +Simply put, the profiler includes time spent in unsafe foreign +calls but ignores time taken in safe foreign calls. For example, time spent blocked on IO +operations (e.g. ``getLine``) is not accounted for in the profile as ``getLine`` is implemented +using a safe foreign call. + +The profiler estimates CPU time, for Haskell threads within the program only. +In particular, time "taken" by the program in blocking safe foreign calls +is not accounted for in time profiles. The runtime has the notion of a virtual +processor which is known as a "capability". Haskell threads are run on capabilities, +and the profiler samples the capabilities in order to determine what is being +executed at a certain time. When a safe foreign call is executed, it's run outside +the context of a capability; hence the sampling does not account for the time +taken. Whilst the safe call is executed, other +Haskell threads are free to run on the capability, and their cost will be attributed +to the profiler. When the safe call is finished, the blocked, descheduled thread can +be resumed and rescheduled. + +However, the time taken by blocking on unsafe foreign calls is accounted for in the profile. +This happens because unsafe foreign calls are executed by the same capability +their calling Haskell thread is running on. Therefore, an unsafe foreign call will +block the entire capability whilst it is running, and any time the capability is +sampled the "cost" of the foreign call will be attributed to the calling cost-centre stack. + +However, do note that you are not supposed to use unsafe foreign calls for any +operations which do block! Do not be tempted to replace your safe foreign calls +with unsafe calls just so they appear in the profile. This prevents GC from +happening until the foreign call returns, which can be catastrophic for performance. + .. _prof-compiler-options: Compiler options for profiling @@ -356,7 +391,9 @@ Automatically placing cost-centres ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ GHC has a number of flags for automatically inserting cost-centres into the -compiled program. +compiled program. Use these options carefully because inserting too many cost-centres +in the wrong places will mean the optimiser will be less effective and the runtime behaviour +of your profiled program will be different to that of the unprofiled one. .. ghc-flag:: -fprof-callers=⟨name⟩ :shortdesc: Auto-add ``SCC``\\ s to all call-sites of the named function. @@ -618,8 +655,10 @@ enclosed between ``+RTS ... -RTS`` as usual): JSON profile format ~~~~~~~~~~~~~~~~~~~ -When invoked with the :rts-flag:`-pj` flag the runtime will emit the cost-centre -profile in a machine-readable JSON format. The top-level object of this format +profile in a machine-readable JSON format. The JSON file can be directly loaded +into `speedscope.app `_ to interactively view the profile. + +The top-level object of this format has the following properties, ``program`` (string) @@ -758,8 +797,12 @@ For instance, a simple profile might look like this, } } +Eventlog profile format +~~~~~~~~~~~~~~~~~~~~~~~ - +In addition to the ``.prof`` and ``.json`` formats the cost centre definitions +and samples are also emitted to the :ref:`eventlog `. The format +of the events is specified in the :ref:`eventlog encodings ` section. .. _prof-heap: @@ -774,18 +817,35 @@ program holds on to more memory at run-time that it needs to. Space leaks lead to slower execution due to heavy garbage collector activity, and may even cause the program to run out of memory altogether. +Heap profiling differs from time profiling in the fact that is not always +necessary to use the profiling runtime to generate a heap profile. There +are two heap profiling modes (:rts-flag:`-hT` and :rts-flag:`-hi` [1]_) which are always +available. + To generate a heap profile from your program: -1. Compile the program for profiling (:ref:`prof-compiler-options`). +1. Assuming you need the profiling runtime, compile the program for profiling (:ref:`prof-compiler-options`). 2. Run it with one of the heap profiling options described below (eg. - :rts-flag:`-hc` for a basic producer profile). This generates the file - :file:`{prog}.hp`. + :rts-flag:`-hc` for a basic producer profile) and enable the eventlog using :rts-flag:`-l <-l ⟨flags⟩>`. - If the :ref:`event log ` is enabled (with the :rts-flag:`-l ⟨flags⟩` - runtime system flag) heap samples will additionally be emitted to the GHC + Heap samples will be emitted to the GHC event log (see :ref:`heap-profiler-events` for details about event format). +3. Render the heap profile using `eventlog2html `_. + This produces an HTML file which contains the visualised profile. + +4. Open the rendered interactive profile in your web browser. + +For example, here is a heap profile produced of using eventlog profiling on GHC +compiling the Cabal library. You can read a lot more about eventlog2html on the website. + +.. image:: images/eventlog_profile.* + +Note that there is the legacy :file:`{prog}.hp` format which has been deprecated +in favour of eventlog based profiling. In order to render the legacy format, the +steps are as follows. + 3. Run :command:`hp2ps` to produce a Postscript file, :file:`{prog}.ps`. The :command:`hp2ps` utility is described in detail in :ref:`hp2ps`. @@ -797,10 +857,6 @@ from GHC's ``nofib`` benchmark suite, .. image:: images/prof_scc.* -You might also want to take a look at -`hp2any `__, a more advanced -suite of tools (not distributed with GHC) for displaying heap profiles. - Note that there might be a big difference between the OS reported memory usage of your program and the amount of live data as reported by heap profiling. The reasons for the difference are explained in :ref:`hints-os-memory`. @@ -817,20 +873,14 @@ following RTS options select which break-down to use: .. rts-flag:: -hT - Breaks down the graph by heap closure type. + Breaks down the graph by heap closure type. This does not require the profiling + runtime. .. rts-flag:: -hc - -h *Requires* :ghc-flag:`-prof`. Breaks down the graph by the cost-centre stack which produced the data. - .. note:: The meaning of the shortened :rts-flag:`-h` is dependent on whether - your program was compiled for profiling. When compiled for profiling, - :rts-flag:`-h` is equivalent to :rts-flag:`-hc`, but otherwise is - equivalent to :rts-flag:`-hT` (see :ref:`rts-profiling`). The :rts-flag:`-h` - is deprecated and will be removed in a future release. - .. rts-flag:: -hm *Requires* :ghc-flag:`-prof`. Break down the live heap by the module @@ -863,7 +913,7 @@ following RTS options select which break-down to use: Break down the graph by the address of the info table of a closure. For this to produce useful output the program must have been compiled with - :ghc-flag:`-finfo-table-map`. + :ghc-flag:`-finfo-table-map` but it does not require the profiling runtime. .. rts-flag:: -l :noindex: @@ -1041,6 +1091,14 @@ This trick isn't foolproof, because there might be other ``B`` closures in the heap which aren't the retainers we are interested in, but we've found this to be a useful technique in most cases. +Precise Retainer Analysis +~~~~~~~~~~~~~~~~~~~~~~~~~ + +If you want to precisely answer questions about why a certain type of closure is +retained then it is worthwhile using `ghc-debug `_ which +has a terminal interface which can be used to easily answer queries such as, what is retaining +a certain closure. + .. _biography-prof: Biographical Profiling @@ -1120,6 +1178,9 @@ reasons for this: allocated by foreign libraries, and data allocated by the RTS), and ``mmap()``\'d memory are not counted in the heap profile. +For more discussion about understanding how understanding process residency see +:ref:`hints-os-memory`. + .. _hp2ps: ``hp2ps`` -- Rendering heap profiles to PostScript @@ -1242,123 +1303,6 @@ The flags are: Print out usage information. -.. _manipulating-hp: - -Manipulating the ``hp`` file -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -(Notes kindly offered by Jan-Willem Maessen.) - -The ``FOO.hp`` file produced when you ask for the heap profile of a -program ``FOO`` is a text file with a particularly simple structure. -Here's a representative example, with much of the actual data omitted: - -.. code-block:: none - - JOB "FOO -hC" - DATE "Thu Dec 26 18:17 2002" - SAMPLE_UNIT "seconds" - VALUE_UNIT "bytes" - BEGIN_SAMPLE 0.00 - END_SAMPLE 0.00 - BEGIN_SAMPLE 15.07 - ... sample data ... - END_SAMPLE 15.07 - BEGIN_SAMPLE 30.23 - ... sample data ... - END_SAMPLE 30.23 - ... etc. - BEGIN_SAMPLE 11695.47 - END_SAMPLE 11695.47 - -The first four lines (``JOB``, ``DATE``, ``SAMPLE_UNIT``, -``VALUE_UNIT``) form a header. Each block of lines starting with -``BEGIN_SAMPLE`` and ending with ``END_SAMPLE`` forms a single sample -(you can think of this as a vertical slice of your heap profile). The -hp2ps utility should accept any input with a properly-formatted header -followed by a series of *complete* samples. - -Zooming in on regions of your profile -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -You can look at particular regions of your profile simply by loading a -copy of the ``.hp`` file into a text editor and deleting the unwanted -samples. The resulting ``.hp`` file can be run through ``hp2ps`` and -viewed or printed. - -Viewing the heap profile of a running program -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -The ``.hp`` file is generated incrementally as your program runs. In -principle, running :command:`hp2ps` on the incomplete file should produce a -snapshot of your program's heap usage. However, the last sample in the -file may be incomplete, causing :command:`hp2ps` to fail. If you are using a -machine with UNIX utilities installed, it's not too hard to work around -this problem (though the resulting command line looks rather Byzantine): - -.. code-block:: sh - - head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \ - | hp2ps > FOO.ps - -The command ``fgrep -n END_SAMPLE FOO.hp`` finds the end of every -complete sample in ``FOO.hp``, and labels each sample with its ending -line number. We then select the line number of the last complete sample -using :command:`tail` and :command:`cut`. This is used as a parameter to :command:`head`; the -result is as if we deleted the final incomplete sample from :file:`FOO.hp`. -This results in a properly-formatted .hp file which we feed directly to -:command:`hp2ps`. - -Viewing a heap profile in real time -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -The :command:`gv` and :command:`ghostview` programs have a "watch file" option -can be used to view an up-to-date heap profile of your program as it runs. -Simply generate an incremental heap profile as described in the previous -section. Run :command:`gv` on your profile: - -.. code-block:: sh - - gv -watch -orientation=seascape FOO.ps - -If you forget the ``-watch`` flag you can still select "Watch file" from -the "State" menu. Now each time you generate a new profile ``FOO.ps`` -the view will update automatically. - -This can all be encapsulated in a little script: - -.. code-block:: sh - - #!/bin/sh - head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \ - | hp2ps > FOO.ps - gv -watch -orientation=seascape FOO.ps & - while [ 1 ] ; do - sleep 10 # We generate a new profile every 10 seconds. - head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \ - | hp2ps > FOO.ps - done - -Occasionally :command:`gv` will choke as it tries to read an incomplete copy of -:file:`FOO.ps` (because :command:`hp2ps` is still running as an update occurs). A -slightly more complicated script works around this problem, by using the -fact that sending a SIGHUP to gv will cause it to re-read its input -file: - -.. code-block:: sh - - #!/bin/sh - head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \ - | hp2ps > FOO.ps - gv FOO.ps & - gvpsnum=$! - while [ 1 ] ; do - sleep 10 - head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \ - | hp2ps > FOO.ps - kill -HUP $gvpsnum - done - .. _prof-threaded: Profiling Parallel and Concurrent Programs @@ -1968,10 +1912,9 @@ Notes about ticky profiling in some columns. For this reason using an eventlog-based approach should be prefered if possible. - .. [1] - :ghc-flag:`-fprof-auto` was known as ``-auto-all`` prior to - GHC 7.4.1. + :rts-flag:`-hi` profiling is avaible with the normal runtime but you will need to + compile with :ghc-flag:`-finfo-table-map` to interpret the results. .. [2] Note that this policy has changed slightly in GHC 7.4.1 relative to View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/799b247e07a81af1a54d1bf5d6e3ecd1a6f020ba...c33a70fc240e197980465cb31ec20e4853c89341 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/799b247e07a81af1a54d1bf5d6e3ecd1a6f020ba...c33a70fc240e197980465cb31ec20e4853c89341 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 07:37:32 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 14 Feb 2023 02:37:32 -0500 Subject: [Git][ghc/ghc][wip/unboxed-codebuffer] Lint Message-ID: <63eb3a3c978ad_26da84369a94444916c@gitlab.mail> Josh Meredith pushed to branch wip/unboxed-codebuffer at Glasgow Haskell Compiler / GHC Commits: 0c4910b5 by Josh Meredith at 2023-02-14T07:37:08+00:00 Lint - - - - - 5 changed files: - libraries/base/GHC/IO/Encoding/Failure.hs - libraries/base/GHC/IO/Encoding/Iconv.hs - libraries/base/GHC/IO/Encoding/UTF16.hs - libraries/base/GHC/IO/Encoding/UTF32.hs - libraries/base/GHC/IO/Encoding/UTF8.hs Changes: ===================================== libraries/base/GHC/IO/Encoding/Failure.hs ===================================== @@ -171,7 +171,7 @@ recoverDecode cfm input at Buffer{ bufRaw=iraw, bufL=ir, bufR=_ } recoverEncode# :: CodingFailureMode -> Buffer Char -> Buffer Word8 -> State# RealWorld -> (# State# RealWorld, Buffer Char, Buffer Word8 #) -recoverEncode# cfm input output st = +recoverEncode# cfm input output st = let (# st', (bIn, bOut) #) = unIO (recoverEncode cfm input output) st in (# st', bIn, bOut #) ===================================== libraries/base/GHC/IO/Encoding/Iconv.hs ===================================== @@ -2,8 +2,8 @@ {-# LANGUAGE CPP , NoImplicitPrelude , NondecreasingIndentation - , UnboxedTuples - , MagicHash + , UnboxedTuples + , MagicHash #-} {-# OPTIONS_HADDOCK not-home #-} @@ -136,7 +136,7 @@ newIConv from to rec fn = iconvt <- throwErrnoIfMinus1 "mkTextEncoding" $ hs_iconv_open to_str from_str let iclose = throwErrnoIfMinus1_ "Iconv.close" $ hs_iconv_close iconvt fn_iconvt ibuf obuf st = case unIO (fn iconvt ibuf obuf) st of - (# st', (prog, ibuf', obuf') #) -> (# st', prog, ibuf', obuf' #) + (# st', (prog, ibuf', obuf') #) -> (# st', prog, ibuf', obuf' #) return BufferCodec{ encode# = fn_iconvt, recover# = rec#, ===================================== libraries/base/GHC/IO/Encoding/UTF16.hs ===================================== @@ -3,7 +3,7 @@ , BangPatterns , NondecreasingIndentation , MagicHash - , UnboxedTuples + , UnboxedTuples #-} {-# OPTIONS_GHC -funbox-strict-fields #-} @@ -111,7 +111,7 @@ utf16_decode seen_bom Nothing -> if iw - ir < 2 then (# st1,InputUnderflow,input,output #) else do let !(# st2, c0 #) = unIO (readWord8Buf iraw ir ) st1 - !(# st3, c1 #) = unIO (readWord8Buf iraw (ir+1)) st2 + !(# st3, c1 #) = unIO (readWord8Buf iraw (ir+1)) st2 case () of _ | c0 == bomB && c1 == bomL -> let !(# st4, () #) = unIO (writeIORef seen_bom (Just utf16be_decode)) st3 @@ -231,10 +231,10 @@ utf16be_decode -- lambda-lifted, to avoid thunks being built in the inner-loop: {-# NOINLINE done #-} done :: CodingProgress -> Int -> Int -> DecodingBuffer - done why !ir !ow st' = + done why !ir !ow st' = let !ri = if ir == iw then input { bufL = 0, bufR = 0 } else input { bufL = ir } - !ro = output{ bufR = ow } - in (# st', why, ri, ro #) + !ro = output{ bufR = ow } + in (# st', why, ri, ro #) in loop ir0 ow0 st @@ -270,10 +270,10 @@ utf16le_decode -- lambda-lifted, to avoid thunks being built in the inner-loop: {-# NOINLINE done #-} done :: CodingProgress -> Int -> Int -> DecodingBuffer - done why !ir !ow st' = + done why !ir !ow st' = let !ri = if ir == iw then input{ bufL = 0, bufR = 0 } else input{ bufL = ir } - !ro = output{ bufR = ow } - in (# st', why, ri, ro #) + !ro = output{ bufR = ow } + in (# st', why, ri, ro #) in loop ir0 ow0 st @@ -285,10 +285,10 @@ utf16be_encode = let {-# NOINLINE done #-} done :: CodingProgress -> Int -> Int -> EncodingBuffer - done why !ir !ow st' = + done why !ir !ow st' = let !ri = if ir == iw then input{ bufL = 0, bufR = 0 } else input{ bufL=ir } !ro = output{ bufR=ow } - in (# st', why, ri, ro #) + in (# st', why, ri, ro #) loop :: Int -> Int -> EncodingBuffer loop !ir !ow st0 | ir >= iw = done InputUnderflow ir ow st0 @@ -326,10 +326,10 @@ utf16le_encode = let {-# NOINLINE done #-} done :: CodingProgress -> Int -> Int -> EncodingBuffer - done why !ir !ow st' = + done why !ir !ow st' = let !ri = if ir == iw then input{ bufL = 0, bufR = 0 } else input{ bufL = ir } - !ro = output{ bufR = ow } - in (# st', why, ri, ro #) + !ro = output{ bufR = ow } + in (# st', why, ri, ro #) loop :: Int -> Int -> EncodingBuffer loop !ir !ow st0 | ir >= iw = done InputUnderflow ir ow st0 ===================================== libraries/base/GHC/IO/Encoding/UTF32.hs ===================================== @@ -230,10 +230,10 @@ utf32be_decode -- lambda-lifted, to avoid thunks being built in the inner-loop: {-# NOINLINE done #-} done :: CodingProgress -> Int -> Int -> DecodingBuffer - done why !ir !ow st' = + done why !ir !ow st' = let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } !ro = output{ bufR=ow } - in (# st', why, ri, ro #) + in (# st', why, ri, ro #) in loop ir0 ow0 st @@ -257,16 +257,16 @@ utf32le_decode let (# st5, ow' #) = unIO (writeCharBuf oraw ow x1) st4 loop (ir+4) ow' st5 where - invalid :: DecodingBuffer + invalid :: DecodingBuffer invalid st' = done InvalidSequence ir ow st' -- lambda-lifted, to avoid thunks being built in the inner-loop: {-# NOINLINE done #-} done :: CodingProgress -> Int -> Int -> DecodingBuffer - done why !ir !ow st' = + done why !ir !ow st' = let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } !ro = output{ bufR=ow } - in (# st', why, ri, ro #) + in (# st', why, ri, ro #) in loop ir0 ow0 st @@ -278,7 +278,7 @@ utf32be_encode = let {-# NOINLINE done #-} done :: CodingProgress -> Int -> Int -> EncodingBuffer - done why !ir !ow st' = + done why !ir !ow st' = let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } !ro = output{ bufR=ow } in (# st', why, ri, ro #) @@ -305,7 +305,7 @@ utf32le_encode st = let done :: CodingProgress -> Int -> Int -> EncodingBuffer - done why !ir !ow st' = + done why !ir !ow st' = let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } !ro = output{ bufR=ow } in (# st', why, ri, ro #) ===================================== libraries/base/GHC/IO/Encoding/UTF8.hs ===================================== @@ -3,7 +3,7 @@ , BangPatterns , NondecreasingIndentation , MagicHash - , UnboxedTuples + , UnboxedTuples #-} {-# OPTIONS_GHC -funbox-strict-fields #-} @@ -196,7 +196,7 @@ utf8_decode if not (validate4 c0 c1 0x80 0x80) then invalid st2 else done InputUnderflow ir ow st2 3 -> do - let !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + let !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 if not (validate4 c0 c1 c2 0x80) then invalid st3 else done InputUnderflow ir ow st3 @@ -210,7 +210,7 @@ utf8_decode | otherwise -> invalid st1 where - invalid :: DecodingBuffer + invalid :: DecodingBuffer invalid st' = done InvalidSequence ir ow st' -- lambda-lifted, to avoid thunks being built in the inner-loop: @@ -218,8 +218,8 @@ utf8_decode done :: CodingProgress -> Int -> Int -> DecodingBuffer done why !ir !ow st' = let !ri = if ir == iw then input{ bufL = 0, bufR = 0} else input{ bufL = ir } - !ro = output { bufR = ow } - in (# st', why, ri, ro #) + !ro = output { bufR = ow } + in (# st', why, ri, ro #) in loop ir0 ow0 st @@ -244,7 +244,7 @@ utf8_encode case ord c of x | x <= 0x7F -> do let !(# st2, () #) = unIO (writeWord8Buf oraw ow (fromIntegral x)) st1 - loop ir' (ow+1) st2 + loop ir' (ow+1) st2 | x <= 0x07FF -> if os - ow < 2 then done OutputUnderflow ir ow st1 else do let (c1,c2) = ord2 c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0c4910b59cc0b133a17396a4c47f74930885029d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0c4910b59cc0b133a17396a4c47f74930885029d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 09:26:25 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 14 Feb 2023 04:26:25 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 14 commits: Add clangd flag to include generated header files Message-ID: <63eb53c147a52_26da84d3664d050749a@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: dcefebe4 by Sven Tennie at 2023-02-14T04:24:59-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - f725b451 by amesgen at 2023-02-14T04:25:02-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - 484bbc3c by Ben Gamari at 2023-02-14T04:25:03-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - 63927021 by Oleg Grenrus at 2023-02-14T04:25:06-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - 22d5c531 by PHO at 2023-02-14T04:25:09-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 7a6939eb by PHO at 2023-02-14T04:25:12-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 94ed3328 by Li-yao Xia at 2023-02-14T04:25:15-05:00 base: Move changelog entry to its place - - - - - 49e10cb3 by Ben Gamari at 2023-02-14T04:25:16-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - f9a6a7e8 by Andreas Klebinger at 2023-02-14T04:25:17-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - f8e6a08d by sheaf at 2023-02-14T04:25:20-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 68cef734 by Cheng Shao at 2023-02-14T04:25:21-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 0912e462 by Simon Hengel at 2023-02-14T04:25:23-05:00 Update outdated references to notes - - - - - 0843404d by meooow25 at 2023-02-14T04:25:26-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 8529fec7 by Cheng Shao at 2023-02-14T04:25:28-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 30 changed files: - .gitlab/rel_eng/upload_ghc_libs.py - compile_flags.txt - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Driver/Config/Stg/Pipeline.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Types.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Origin.hs-boot - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Fixity.hs - compiler/GHC/Types/ForeignCall.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ab8466253adec59a2ff0e1aaf3000465a08511bc...8529fec7d18c07a544f6a96c4eab383073fc733e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ab8466253adec59a2ff0e1aaf3000465a08511bc...8529fec7d18c07a544f6a96c4eab383073fc733e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 11:42:30 2023 From: gitlab at gitlab.haskell.org (Bryan R (@chreekat)) Date: Tue, 14 Feb 2023 06:42:30 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/b/mark-tests-fragile Message-ID: <63eb73a676195_26da84c2ec974630939@gitlab.mail> Bryan R pushed new branch wip/b/mark-tests-fragile at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/b/mark-tests-fragile You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 11:44:17 2023 From: gitlab at gitlab.haskell.org (Bryan R (@chreekat)) Date: Tue, 14 Feb 2023 06:44:17 -0500 Subject: [Git][ghc/ghc][wip/b/mark-tests-fragile] 110 commits: Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Message-ID: <63eb74116f562_26da84d3664d06332c1@gitlab.mail> Bryan R pushed to branch wip/b/mark-tests-fragile at Glasgow Haskell Compiler / GHC Commits: 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - a98b09fc by Bryan Richter at 2023-02-14T13:44:05+02:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - cd8d230e by Bryan Richter at 2023-02-14T13:44:05+02:00 Mark all T5435 variants as fragile See #22970. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - cabal.project-reinstall - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Reg.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/BlockLayout.hs - compiler/GHC/CmmToAsm/Dwarf.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/447d4abb43715339ee354be56077c4ec268ba98f...cd8d230e5f7380968e89d2c910e464d6de2ec531 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/447d4abb43715339ee354be56077c4ec268ba98f...cd8d230e5f7380968e89d2c910e464d6de2ec531 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 11:56:56 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 14 Feb 2023 06:56:56 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 14 commits: Add clangd flag to include generated header files Message-ID: <63eb770852a6c_26da8448900e0647630@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: dcfbcf8e by Sven Tennie at 2023-02-14T06:55:51-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - 2ffc2846 by amesgen at 2023-02-14T06:55:55-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - 2901da0d by Ben Gamari at 2023-02-14T06:55:55-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - 38997227 by PHO at 2023-02-14T06:55:58-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 6763d77e by PHO at 2023-02-14T06:56:01-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 1a45c228 by Li-yao Xia at 2023-02-14T06:56:04-05:00 base: Move changelog entry to its place - - - - - e556e759 by Ben Gamari at 2023-02-14T06:56:05-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - bc9b1c9b by Andreas Klebinger at 2023-02-14T06:56:06-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 0584af5e by sheaf at 2023-02-14T06:56:13-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - f00fb171 by Cheng Shao at 2023-02-14T06:56:14-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 76a14ea7 by Simon Hengel at 2023-02-14T06:56:16-05:00 Update outdated references to notes - - - - - ee8fa012 by meooow25 at 2023-02-14T06:56:19-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 47d25be1 by romes at 2023-02-14T06:56:19-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 79e42dbf by Cheng Shao at 2023-02-14T06:56:21-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 30 changed files: - .gitlab/rel_eng/upload_ghc_libs.py - compile_flags.txt - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Driver/Config/Stg/Pipeline.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Types.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Origin.hs-boot - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Fixity.hs - compiler/GHC/Types/ForeignCall.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/Language/Haskell/Syntax/Decls.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8529fec7d18c07a544f6a96c4eab383073fc733e...79e42dbf194453526f80ff204d3ebdde7e25d934 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8529fec7d18c07a544f6a96c4eab383073fc733e...79e42dbf194453526f80ff204d3ebdde7e25d934 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 13:41:15 2023 From: gitlab at gitlab.haskell.org (Bryan R (@chreekat)) Date: Tue, 14 Feb 2023 08:41:15 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/b/normal-hadrian-verbosity Message-ID: <63eb8f7b63b9b_26da84ea45ee47606b@gitlab.mail> Bryan R pushed new branch wip/b/normal-hadrian-verbosity at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/b/normal-hadrian-verbosity You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 14:00:20 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 14 Feb 2023 09:00:20 -0500 Subject: [Git][ghc/ghc][wip/rts-warnings] hadrian: Ensure that -Werror is passed when compiling the RTS. Message-ID: <63eb93f49a3ae_26da84ea45ee47840d1@gitlab.mail> Ben Gamari pushed to branch wip/rts-warnings at Glasgow Haskell Compiler / GHC Commits: e594159d by Ben Gamari at 2023-02-14T09:00:14-05:00 hadrian: Ensure that -Werror is passed when compiling the RTS. Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler when building the RTS. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. I tried to enable `-Werror` in all C compilations but the boot libraries are something of a portability nightmare. - - - - - 1 changed file: - hadrian/src/Flavour.hs Changes: ===================================== hadrian/src/Flavour.hs ===================================== @@ -122,16 +122,25 @@ addArgs args' fl = fl { args = args fl <> args' } -- from warnings. werror :: Flavour -> Flavour werror = - addArgs - ( builder Ghc + addArgs $ mconcat + [ builder Ghc ? notStage0 ? mconcat - [ arg "-Werror", - flag CrossCompiling + [ arg "-Werror" + , flag CrossCompiling ? package unix ? mconcat [arg "-Wwarn=unused-imports", arg "-Wwarn=unused-top-binds"] ] - ) + , builder Ghc + ? package rts + ? mconcat + [ arg "-optc-Werror" + -- clang complains about #pragma GCC pragmas + , arg "-optc-Wno-error=unknown-pragmas" + ] + -- N.B. We currently don't build the boot libraries' C sources with -Werror + -- as this tends to be a portability nightmare. + ] -- | Build C and Haskell objects with debugging information. enableDebugInfo :: Flavour -> Flavour View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e594159d6f40c4d7e2230bb9ac92204f221bd9f7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e594159d6f40c4d7e2230bb9ac92204f221bd9f7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 14:38:29 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 14 Feb 2023 09:38:29 -0500 Subject: [Git][ghc/ghc][wip/T22883] 53 commits: Bump transformers submodule to 0.6.0.6 Message-ID: <63eb9ce585a63_26da84bb0cd44809911@gitlab.mail> Ben Gamari pushed to branch wip/T22883 at Glasgow Haskell Compiler / GHC Commits: 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 01b1f2e9 by Ben Gamari at 2023-02-14T09:12:48-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md - compiler/GHC.hs - compiler/GHC/CmmToLlvm/Mangler.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/List/SetOps.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Arrows.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3051718c12849c96d049aec2a5b06e237f38aa35...01b1f2e9a90de5ff693d92b087e8c40b21979b18 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3051718c12849c96d049aec2a5b06e237f38aa35...01b1f2e9a90de5ff693d92b087e8c40b21979b18 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 16:04:32 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Tue, 14 Feb 2023 11:04:32 -0500 Subject: [Git][ghc/ghc][wip/js-th] 47 commits: Enable tables next to code for LoongArch64 Message-ID: <63ebb1104e58e_26da8449bc6d08662d7@gitlab.mail> Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC Commits: 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - fdd0a01e by Sylvain Henry at 2023-02-13T18:03:24+01:00 Merge libiserv with ghci - - - - - 8da178e1 by Sylvain Henry at 2023-02-13T18:03:24+01:00 Wire ghci unit - - - - - 8c292fce by Sylvain Henry at 2023-02-13T18:03:24+01:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 79bf36dd by Sylvain Henry at 2023-02-13T18:03:24+01:00 Fix some tests - - - - - 1d854bcb by Sylvain Henry at 2023-02-13T18:03:24+01:00 Fix comment for silly haddock - - - - - eb495795 by Sylvain Henry at 2023-02-13T18:19:54+01:00 Testsuite: fix unexpected passes - - - - - 230bc1f4 by Sylvain Henry at 2023-02-14T10:01:41+01:00 Fix after renaming js/javascript - - - - - 4c0fa781 by Sylvain Henry at 2023-02-14T10:30:38+01:00 Testsuite: more - - - - - d837663e by Sylvain Henry at 2023-02-14T16:47:00+01:00 Fix: ensure we use unique GhciNNNN module names - - - - - fb28a464 by Sylvain Henry at 2023-02-14T17:06:42+01:00 Testsuite: fix more tests - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md - CODEOWNERS - cabal.project-reinstall - compiler/GHC.hs - compiler/GHC/CmmToLlvm/Mangler.hs - compiler/GHC/Core.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Data/List/SetOps.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/653bf305257c886845e80e1b692e105d8cd18ece...fb28a4643155c252ff7f2cefc5d466234bf04d89 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/653bf305257c886845e80e1b692e105d8cd18ece...fb28a4643155c252ff7f2cefc5d466234bf04d89 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 16:06:21 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 14 Feb 2023 11:06:21 -0500 Subject: [Git][ghc/ghc][wip/js-rts-fixmes] Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching Message-ID: <63ebb17d802d3_26da846201d58866585@gitlab.mail> Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC Commits: 141cba6d by Josh Meredith at 2023-02-14T16:05:32+00:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 4 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -129,7 +129,11 @@ module GHC.JS.Make -- * Miscellaneous -- $misc , allocData, allocClsA - , dataFieldName, dataFieldNames + , dataName + , clsName + , dataFieldName + , varName + , jsClosureCount ) where @@ -142,10 +146,8 @@ import Control.Arrow ((***)) import Data.Array import qualified Data.Map as M -import GHC.Utils.Outputable (Outputable (..)) import GHC.Data.FastString import GHC.Utils.Monad.State.Strict -import GHC.Utils.Panic import GHC.Utils.Misc import GHC.Types.Unique.Map @@ -641,31 +643,52 @@ instance Fractional JExpr where dataFieldCache :: Array Int FastString dataFieldCache = listArray (0,nFieldCache) (map (mkFastString . ('d':) . show) [(0::Int)..nFieldCache]) +-- | Data names are used in the AST, and logging has determined that 255 is the maximum number we see. nFieldCache :: Int -nFieldCache = 16384 +nFieldCache = 255 + +-- | We use this in the RTS to determine the number of generated closures. These closures use the names +-- cached here, so we bind them to the same number. +jsClosureCount :: Int +jsClosureCount = 24 dataFieldName :: Int -> FastString dataFieldName i - | i < 1 || i > nFieldCache = panic "dataFieldName" (ppr i) + | i < 0 || i > nFieldCache = mkFastString ('d' : show i) | otherwise = dataFieldCache ! i -dataFieldNames :: [FastString] -dataFieldNames = fmap dataFieldName [1..nFieldCache] - - -- | Cache "h$dXXX" names dataCache :: Array Int FastString -dataCache = listArray (0,1024) (map (mkFastString . ("h$d"++) . show) [(0::Int)..1024]) +dataCache = listArray (0,jsClosureCount) (map (mkFastString . ("h$d"++) . show) [(0::Int)..jsClosureCount]) + +dataName :: Int -> FastString +dataName i + | i < 0 || i > nFieldCache = mkFastString ("h$d" ++ show i) + | otherwise = dataCache ! i allocData :: Int -> JExpr -allocData i = toJExpr (TxtI (dataCache ! i)) +allocData i = toJExpr (TxtI (dataName i)) -- | Cache "h$cXXX" names clsCache :: Array Int FastString -clsCache = listArray (0,1024) (map (mkFastString . ("h$c"++) . show) [(0::Int)..1024]) +clsCache = listArray (0,jsClosureCount) (map (mkFastString . ("h$c"++) . show) [(0::Int)..jsClosureCount]) + +clsName :: Int -> FastString +clsName i + | i < 0 || i > jsClosureCount = mkFastString ("h$c" ++ show i) + | otherwise = clsCache ! i allocClsA :: Int -> JExpr -allocClsA i = toJExpr (TxtI (clsCache ! i)) +allocClsA i = toJExpr (TxtI (clsName i)) + +-- | Cache "xXXX" names +varCache :: Array Int Ident +varCache = listArray (0,jsClosureCount) (map (TxtI . mkFastString . ('x':) . show) [(0::Int)..jsClosureCount]) + +varName :: Int -> Ident +varName i + | i < 0 || i > jsClosureCount = TxtI $ mkFastString ('x' : show i) + | otherwise = varCache ! i -------------------------------------------------------------------------------- ===================================== compiler/GHC/StgToJS/DataCon.hs ===================================== @@ -97,7 +97,7 @@ allocDynamicE :: Bool -- ^ csInlineAlloc from StgToJSConfig -> Maybe JExpr -> JExpr allocDynamicE inline_alloc entry free cc - | inline_alloc || length free > 24 = newClosure $ Closure + | inline_alloc || length free > jsClosureCount = newClosure $ Closure { clEntry = entry , clField1 = fillObj1 , clField2 = fillObj2 ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -1006,7 +1006,7 @@ allocDynAll haveDecl middle cls = do ] (ex:es) -> mconcat [ toJExpr i .^ closureField1_ |= toJExpr ex - , toJExpr i .^ closureField2_ |= toJExpr (jhFromList (zip dataFieldNames es)) + , toJExpr i .^ closureField2_ |= toJExpr (jhFromList (zip (map dataFieldName [1..]) es)) ] | otherwise = case es of [] -> mempty ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -81,36 +81,8 @@ resetResultVar r = toJExpr r |= null_ -- JIT can optimize better. closureConstructors :: StgToJSConfig -> JStat closureConstructors s = BlockStat - [ declClsConstr "h$c" ["f"] $ Closure - { clEntry = var "f" - , clField1 = null_ - , clField2 = null_ - , clMeta = 0 - , clCC = ccVal - } - , declClsConstr "h$c0" ["f"] $ Closure - { clEntry = var "f" - , clField1 = null_ - , clField2 = null_ - , clMeta = 0 - , clCC = ccVal - } - , declClsConstr "h$c1" ["f", "x1"] $ Closure - { clEntry = var "f" - , clField1 = var "x1" - , clField2 = null_ - , clMeta = 0 - , clCC = ccVal - } - , declClsConstr "h$c2" ["f", "x1", "x2"] $ Closure - { clEntry = var "f" - , clField1 = var "x1" - , clField2 = var "x2" - , clMeta = 0 - , clCC = ccVal - } - , mconcat (map mkClosureCon [3..24]) - , mconcat (map mkDataFill [1..24]) + [ mconcat (map mkClosureCon (Nothing : map Just [0..jsClosureCount])) + , mconcat (map mkDataFill [1..jsClosureCount]) ] where prof = csProf s @@ -118,19 +90,8 @@ closureConstructors s = BlockStat -- the cc argument happens to be named just like the cc field... | prof = ([TxtI closureCC_], Just (var closureCC_)) | otherwise = ([], Nothing) - addCCArg as = map TxtI as ++ ccArg addCCArg' as = as ++ ccArg - declClsConstr i as cl = TxtI i ||= ValExpr (JFunc (addCCArg as) - ( jVar $ \x -> - [ checkC - , x |= newClosure cl - , notifyAlloc x - , traceAlloc x - , returnS x - ] - )) - traceAlloc x | csTraceRts s = appS "h$traceAlloc" [x] | otherwise = mempty @@ -172,26 +133,36 @@ closureConstructors s = BlockStat | otherwise = mempty - mkClosureCon :: Int -> JStat - mkClosureCon n = funName ||= toJExpr fun + mkClosureCon :: Maybe Int -> JStat + mkClosureCon n0 = funName ||= toJExpr fun where - funName = TxtI $ mkFastString ("h$c" ++ show n) + n | Just n' <- n0 = n' + | Nothing <- n0 = 0 + funName | Just n' <- n0 = TxtI $ clsName n' + | Nothing <- n0 = TxtI $ mkFastString "h$c" -- args are: f x1 x2 .. xn [cc] - args = TxtI "f" : addCCArg' (map (TxtI . mkFastString . ('x':) . show) [(1::Int)..n]) + args = TxtI "f" : addCCArg' (map varName [1..n]) fun = JFunc args funBod -- x1 goes into closureField1. All the other args are bundled into an -- object in closureField2: { d1 = x2, d2 = x3, ... } -- - extra_args = ValExpr . JHash . listToUniqMap $ zip - (map (mkFastString . ('d':) . show) [(1::Int)..]) - (map (toJExpr . TxtI . mkFastString . ('x':) . show) [2..n]) + vars = map (toJExpr . varName) [1..n] + + x1 = case vars of + [] -> null_ + x:_ -> x + x2 = case vars of + [] -> null_ + [_] -> null_ + [_,x] -> x + _:x:xs -> ValExpr . JHash . listToUniqMap $ zip (map dataFieldName [1..]) (x:xs) funBod = jVar $ \x -> [ checkC , x |= newClosure Closure { clEntry = var "f" - , clField1 = var "x1" - , clField2 = extra_args + , clField1 = x1 + , clField2 = x2 , clMeta = 0 , clCC = ccVal } @@ -203,8 +174,8 @@ closureConstructors s = BlockStat mkDataFill :: Int -> JStat mkDataFill n = funName ||= toJExpr fun where - funName = TxtI $ mkFastString ("h$d" ++ show n) - ds = map (mkFastString . ('d':) . show) [(1::Int)..n] + funName = TxtI $ dataName n + ds = map dataFieldName [1..n] extra_args = ValExpr . JHash . listToUniqMap . zip ds $ map (toJExpr . TxtI) ds fun = JFunc (map TxtI ds) (checkD <> returnS extra_args) @@ -215,7 +186,7 @@ stackManip = mconcat (map mkPush [1..32]) <> where mkPush :: Int -> JStat mkPush n = let funName = TxtI $ mkFastString ("h$p" ++ show n) - as = map (TxtI . mkFastString . ('x':) . show) [1..n] + as = map varName [1..n] fun = JFunc as ((sp |= sp + toJExpr n) <> mconcat (zipWith (\i a -> stack .! (sp - toJExpr (n-i)) |= toJExpr a) [1..] as)) @@ -228,7 +199,7 @@ stackManip = mconcat (map mkPush [1..32]) <> bits = bitsIdx sig n = length bits h = last bits - args = map (TxtI . mkFastString . ('x':) . show) [1..n] + args = map varName [1..n] fun = JFunc args $ mconcat [ sp |= sp + toJExpr (h+1) , mconcat (zipWith (\b a -> stack .! (sp - toJExpr (h-b)) |= toJExpr a) bits args) @@ -288,7 +259,7 @@ loadRegs :: JStat loadRegs = mconcat $ map mkLoad [1..32] where mkLoad :: Int -> JStat - mkLoad n = let args = map (TxtI . mkFastString . ("x"++) . show) [1..n] + mkLoad n = let args = map varName [1..n] assign = zipWith (\a r -> toJExpr r |= toJExpr a) args (reverse $ take n regsFromR1) fname = TxtI $ mkFastString ("h$l" ++ show n) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/141cba6d53b706b65bb6b583aa8b7c3a7c9ac08d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/141cba6d53b706b65bb6b583aa8b7c3a7c9ac08d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 16:26:48 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 14 Feb 2023 11:26:48 -0500 Subject: [Git][ghc/ghc][master] Add clangd flag to include generated header files Message-ID: <63ebb648c8c2a_26da84c2ec9748772ed@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - 1 changed file: - compile_flags.txt Changes: ===================================== compile_flags.txt ===================================== @@ -2,4 +2,4 @@ -Irts -Irts/include -I.hie-bios/stage0/lib - +-I_build/stage1/rts/build/include/ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/16adc349b7f1d7185a74eedc2e3e3d0cffa5db84 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/16adc349b7f1d7185a74eedc2e3e3d0cffa5db84 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 16:27:31 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 14 Feb 2023 11:27:31 -0500 Subject: [Git][ghc/ghc][master] Mention new `Foreign.Marshal.Pool` implementation in User's Guide Message-ID: <63ebb67331483_26da8449bc6a888073@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - 1 changed file: - docs/users_guide/exts/ffi.rst Changes: ===================================== docs/users_guide/exts/ffi.rst ===================================== @@ -807,11 +807,9 @@ the different kinds of allocation perform with GHC. the other forms of allocation above. ``Foreign.Marshal.Pool`` - Pools are currently implemented using ``malloc/free``, so while they - might be a more convenient way to structure your memory allocation - than using one of the other forms of allocation, they won't be any - more efficient. We do plan to provide an improved-performance - implementation of Pools in the future, however. + Pools can be a more convenient way to structure your memory + allocation than using one of the other forms of allocation. They are + backed by the RTS internal arena instead of ``malloc/free``. .. _ffi-threads: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c399ccd97892fd536abf64b03f467e8fe4cc50e5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c399ccd97892fd536abf64b03f467e8fe4cc50e5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 16:28:08 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 14 Feb 2023 11:28:08 -0500 Subject: [Git][ghc/ghc][master] upload_ghc_libs: More control over which packages to operate on Message-ID: <63ebb69835ee8_26da84d3664d088419f@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - 1 changed file: - .gitlab/rel_eng/upload_ghc_libs.py Changes: ===================================== .gitlab/rel_eng/upload_ghc_libs.py ===================================== @@ -197,19 +197,24 @@ def main() -> None: parser_prepare.add_argument('--bindist', required=True, type=Path, help='extracted binary distribution') parser_upload = subparsers.add_parser('upload') + parser_upload.add_argument('--skip', default=[], action='append', type=str, help='skip uploading of the given package') parser_upload.add_argument('--docs', required = True, type=Path, help='folder created by --prepare') parser_upload.add_argument('--publish', action='store_true', help='Publish Hackage packages instead of just uploading candidates') args = parser.parse_args() - pkgs = args.pkg + pkgs = set(args.pkg) for pkg_name in pkgs: assert pkg_name in PACKAGES - if pkgs == []: - pkgs = PACKAGES.keys() + if not pkgs: + pkgs = set(PACKAGES.keys()) - if args.command == "prepare": + if args.command == "upload": + for pkg_name in args.skip: + assert pkg_name in PACKAGES + pkgs = pkgs - set(args.skip) + if args.command == "prepare": manifest = {} for pkg_name in pkgs: print(pkg_name) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b9282cf76f237412bae43e37c7a3deccb9fb22a1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b9282cf76f237412bae43e37c7a3deccb9fb22a1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 16:28:41 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Tue, 14 Feb 2023 11:28:41 -0500 Subject: [Git][ghc/ghc][wip/js-th] Testsuite: req_bco already exists Message-ID: <63ebb6b918e87_26da8449bc6d08878e7@gitlab.mail> Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC Commits: 085fc04b by Sylvain Henry at 2023-02-14T17:33:03+01:00 Testsuite: req_bco already exists - - - - - 1 changed file: - testsuite/driver/testlib.py Changes: ===================================== testsuite/driver/testlib.py ===================================== @@ -294,13 +294,6 @@ def req_ffi_exports( name, opts): # JS backend doesn't support FFI exports (yet) js_skip(name, opts) -def req_bco( name, opts): - """ - Mark a test as requiring Byte-Code support - """ - # JS backend doesn't support BCO - js_skip(name, opts) - def req_asm( name, opts): """ Mark a test as requiring LangAsm support View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/085fc04bd2fda63cfb918bb4952714748ad48406 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/085fc04bd2fda63cfb918bb4952714748ad48406 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 16:28:59 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 14 Feb 2023 11:28:59 -0500 Subject: [Git][ghc/ghc][master] Assume platforms support rpaths if they use either ELF or Mach-O Message-ID: <63ebb6cbf25bd_26da841f6de560888565@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 1 changed file: - hadrian/src/Oracles/Setting.hs Changes: ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -272,20 +272,28 @@ anyTargetArch = matchSetting TargetArch anyHostOs :: [String] -> Action Bool anyHostOs = matchSetting HostOs --- | Check whether the target OS uses the ELF object format. -isElfTarget :: Action Bool -isElfTarget = anyTargetOs +-- | List of OSes that use the ELF object format. +elfOSes :: [String] +elfOSes = [ "linux", "freebsd", "dragonfly", "openbsd", "netbsd", "solaris2", "kfreebsdgnu" , "haiku", "linux-android" ] +-- | List of OSes that use the Mach-O object format. +machoOSes :: [String] +machoOSes = [ "darwin" ] + +-- | Check whether the target OS uses the ELF object format. +isElfTarget :: Action Bool +isElfTarget = anyTargetOs elfOSes + -- | Check whether the host OS supports the @-rpath@ linker option when -- using dynamic linking. -- -- TODO: Windows supports lazy binding (but GHC doesn't currently support -- dynamic way on Windows anyways). hostSupportsRPaths :: Action Bool -hostSupportsRPaths = anyHostOs ["linux", "darwin", "freebsd"] +hostSupportsRPaths = anyHostOs (elfOSes ++ machoOSes) -- | Check whether the target supports GHCi. ghcWithInterpreter :: Action Bool View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aa3a262d1537b30c21a8b887385cc538440e7a44 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aa3a262d1537b30c21a8b887385cc538440e7a44 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 16:29:27 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 14 Feb 2023 11:29:27 -0500 Subject: [Git][ghc/ghc][master] RTS linker: Improve compatibility with NetBSD Message-ID: <63ebb6e724fc3_26da8449bc6d0892225@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 2 changed files: - rts/linker/MMap.c - rts/linker/MMap.h Changes: ===================================== rts/linker/MMap.c ===================================== @@ -46,6 +46,8 @@ static const char *memoryAccessDescription(MemoryAccess mode) case MEM_NO_ACCESS: return "no-access"; case MEM_READ_ONLY: return "read-only"; case MEM_READ_WRITE: return "read-write"; + case MEM_READ_WRITE_THEN_READ_EXECUTE: + return "read-write-then-read-execute"; case MEM_READ_EXECUTE: return "read-execute"; case MEM_READ_WRITE_EXECUTE: return "read-write-execute"; @@ -63,13 +65,6 @@ struct MemoryRegion { */ }; -#define LOW_ADDR 0x01000000 -static struct MemoryRegion allMemory = { - .start = (void *) LOW_ADDR, - .end = (void *) -1, - .last = (void *) LOW_ADDR -}; - #if defined(mingw32_HOST_OS) /* A wrapper for VirtualQuery() providing useful debug output */ @@ -196,6 +191,8 @@ memoryAccessToProt(MemoryAccess access) case MEM_NO_ACCESS: return PAGE_NOACCESS; case MEM_READ_ONLY: return PAGE_READONLY; case MEM_READ_WRITE: return PAGE_READWRITE; + case MEM_READ_WRITE_THEN_READ_EXECUTE: + return PAGE_READWRITE; case MEM_READ_EXECUTE: return PAGE_EXECUTE_READ; case MEM_READ_WRITE_EXECUTE: return PAGE_EXECUTE_READWRITE; @@ -258,6 +255,17 @@ memoryAccessToProt(MemoryAccess access) case MEM_NO_ACCESS: return 0; case MEM_READ_ONLY: return PROT_READ; case MEM_READ_WRITE: return PROT_READ | PROT_WRITE; + case MEM_READ_WRITE_THEN_READ_EXECUTE: +# if defined(netbsd_HOST_OS) + /* PROT_MPROTECT(PROT_EXEC) means that the pages are going to be + * marked as executable in the future. On NetBSD requesting + * additional permissions with mprotect(2) only succeeds when + * permissions were initially requested in this manner. + */ + return PROT_READ | PROT_WRITE | PROT_MPROTECT(PROT_EXEC); +# else + return PROT_READ | PROT_WRITE; +# endif case MEM_READ_EXECUTE: return PROT_READ | PROT_EXEC; case MEM_READ_WRITE_EXECUTE: return PROT_READ | PROT_WRITE | PROT_EXEC; @@ -301,6 +309,18 @@ nearImage(void) { return ®ion; } +static void * +mmapAnywhere ( + size_t bytes, + MemoryAccess access, + uint32_t flags, + int fd, + int offset) +{ + int prot = memoryAccessToProt(access); + return doMmap(NULL, bytes, prot, flags, fd, offset); +} + static void * mmapInRegion ( struct MemoryRegion *region, @@ -358,17 +378,23 @@ mmapForLinker (size_t bytes, MemoryAccess access, uint32_t flags, int fd, int of IF_DEBUG(linker_verbose, debugBelch("mmapForLinker: start\n")); if (RtsFlags.MiscFlags.linkerAlwaysPic) { /* make no attempt at mapping low memory if we are assuming PIC */ - region = &allMemory; + region = NULL; } else { region = nearImage(); } /* Use MAP_32BIT if appropriate */ - if (region->end <= (void *) 0xffffffff) { + if (region && region->end <= (void *) 0xffffffff) { flags |= TRY_MAP_32BIT; } - void *result = mmapInRegion(region, bytes, access, flags, fd, offset); + void *result; + if (region) { + result = mmapInRegion(region, bytes, access, flags, fd, offset); + } + else { + result = mmapAnywhere(bytes, access, flags, fd, offset); + } IF_DEBUG(linker_verbose, debugBelch("mmapForLinker: mapped %zd bytes starting at %p\n", bytes, result)); @@ -383,7 +409,7 @@ mmapForLinker (size_t bytes, MemoryAccess access, uint32_t flags, int fd, int of void * mmapAnonForLinker (size_t bytes) { - return mmapForLinker (bytes, MEM_READ_WRITE, MAP_ANONYMOUS, -1, 0); + return mmapForLinker (bytes, MEM_READ_WRITE_THEN_READ_EXECUTE, MAP_ANONYMOUS, -1, 0); } void munmapForLinker (void *addr, size_t bytes, const char *caller) ===================================== rts/linker/MMap.h ===================================== @@ -54,6 +54,8 @@ typedef enum { MEM_NO_ACCESS, MEM_READ_ONLY, MEM_READ_WRITE, + // Initially map pages as rw- and then switch to r-x later. + MEM_READ_WRITE_THEN_READ_EXECUTE, MEM_READ_EXECUTE, MEM_READ_WRITE_EXECUTE, } MemoryAccess; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4771602447c877a4ec6e159e016668569e4a5366 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4771602447c877a4ec6e159e016668569e4a5366 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 16:30:09 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 14 Feb 2023 11:30:09 -0500 Subject: [Git][ghc/ghc][master] base: Move changelog entry to its place Message-ID: <63ebb71130744_26da8449bc608895739@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 1 changed file: - libraries/base/changelog.md Changes: ===================================== libraries/base/changelog.md ===================================== @@ -146,6 +146,10 @@ `Word64#` and `Int64#`, respectively. Previously on 32-bit platforms these were rather represented by `Word#` and `Int#`. See GHC #11953. + * Add `GHC.TypeError` module to contain functionality related to custom type + errors. `TypeError` is re-exported from `GHC.TypeLits` for backwards + compatibility. + ## 4.16.3.0 *May 2022* * Shipped with GHC 9.2.4 @@ -223,10 +227,6 @@ * `fromInteger :: Integer -> Float/Double` now consistently round to the nearest value, with ties to even. - * Add `GHC.TypeError` module to contain functionality related to custom type - errors. `TypeError` is re-exported from `GHC.TypeLits` for backwards - compatibility. - * Comparison constraints in `Data.Type.Ord` (e.g. `<=`) now use the new `GHC.TypeError.Assert` type family instead of type equality with `~`. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/11de324aae17794c8753a8f7cb50c4140785fe27 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/11de324aae17794c8753a8f7cb50c4140785fe27 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 16:30:48 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 14 Feb 2023 11:30:48 -0500 Subject: [Git][ghc/ghc][master] nativeGen/AArch64: Emit Atomic{Read,Write} inline Message-ID: <63ebb73865989_26da8449bc6a89015a3@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - 3 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -1532,9 +1532,34 @@ genCCall target dest_regs arg_regs bid = do MO_BRev w -> mkCCall (bRevLabel w) -- -- Atomic read-modify-write. + MO_AtomicRead w ord + | [p_reg] <- arg_regs + , [dst_reg] <- dest_regs -> do + (p, _fmt_p, code_p) <- getSomeReg p_reg + platform <- getPlatform + let instr = case ord of + MemOrderRelaxed -> LDR + _ -> LDAR + dst = getRegisterReg platform (CmmLocal dst_reg) + code = + code_p `snocOL` + instr (intFormat w) (OpReg w dst) (OpAddr $ AddrReg p) + return (code, Nothing) + | otherwise -> panic "mal-formed AtomicRead" + MO_AtomicWrite w ord + | [p_reg, val_reg] <- arg_regs -> do + (p, _fmt_p, code_p) <- getSomeReg p_reg + (val, fmt_val, code_val) <- getSomeReg val_reg + let instr = case ord of + MemOrderRelaxed -> STR + _ -> STLR + code = + code_p `appOL` + code_val `snocOL` + instr fmt_val (OpReg w val) (OpAddr $ AddrReg p) + return (code, Nothing) + | otherwise -> panic "mal-formed AtomicWrite" MO_AtomicRMW w amop -> mkCCall (atomicRMWLabel w amop) - MO_AtomicRead w _ -> mkCCall (atomicReadLabel w) - MO_AtomicWrite w _ -> mkCCall (atomicWriteLabel w) MO_Cmpxchg w -> mkCCall (cmpxchgLabel w) -- -- Should be an AtomicRMW variant eventually. -- -- Sequential consistent. ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -127,7 +127,9 @@ regUsageOfInstr platform instr = case instr of CBNZ src _ -> usage (regOp src, []) -- 7. Load and Store Instructions -------------------------------------------- STR _ src dst -> usage (regOp src ++ regOp dst, []) + STLR _ src dst -> usage (regOp src ++ regOp dst, []) LDR _ dst src -> usage (regOp src, regOp dst) + LDAR _ dst src -> usage (regOp src, regOp dst) -- TODO is this right? see STR, which I'm only partial about being right? STP _ src1 src2 dst -> usage (regOp src1 ++ regOp src2 ++ regOp dst, []) LDP _ dst1 dst2 src -> usage (regOp src, regOp dst1 ++ regOp dst2) @@ -263,7 +265,9 @@ patchRegsOfInstr instr env = case instr of CBNZ o l -> CBNZ (patchOp o) l -- 7. Load and Store Instructions ------------------------------------------ STR f o1 o2 -> STR f (patchOp o1) (patchOp o2) + STLR f o1 o2 -> STLR f (patchOp o1) (patchOp o2) LDR f o1 o2 -> LDR f (patchOp o1) (patchOp o2) + LDAR f o1 o2 -> LDAR f (patchOp o1) (patchOp o2) STP f o1 o2 o3 -> STP f (patchOp o1) (patchOp o2) (patchOp o3) LDP f o1 o2 o3 -> LDP f (patchOp o1) (patchOp o2) (patchOp o3) @@ -616,7 +620,9 @@ data Instr -- Load and stores. -- TODO STR/LDR might want to change to STP/LDP with XZR for the second register. | STR Format Operand Operand -- str Xn, address-mode // Xn -> *addr + | STLR Format Operand Operand -- stlr Xn, address-mode // Xn -> *addr | LDR Format Operand Operand -- ldr Xn, address-mode // Xn <- *addr + | LDAR Format Operand Operand -- ldar Xn, address-mode // Xn <- *addr | STP Format Operand Operand Operand -- stp Xn, Xm, address-mode // Xn -> *addr, Xm -> *(addr + 8) | LDP Format Operand Operand Operand -- stp Xn, Xm, address-mode // Xn <- *addr, Xm <- *(addr + 8) @@ -691,7 +697,9 @@ instrCon i = ROR{} -> "ROR" TST{} -> "TST" STR{} -> "STR" + STLR{} -> "STLR" LDR{} -> "LDR" + LDAR{} -> "LDAR" STP{} -> "STP" LDP{} -> "LDP" CSET{} -> "CSET" ===================================== compiler/GHC/CmmToAsm/AArch64/Ppr.hs ===================================== @@ -469,6 +469,7 @@ pprInstr platform instr = case instr of STR _f o1@(OpReg W16 (RegReal (RealRegSingle i))) o2 | i < 32 -> op2 (text "\tstrh") o1 o2 STR _f o1 o2 -> op2 (text "\tstr") o1 o2 + STLR _f o1 o2 -> op2 (text "\tstlr") o1 o2 #if defined(darwin_HOST_OS) LDR _f o1 (OpImm (ImmIndex lbl' off)) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' -> @@ -533,6 +534,7 @@ pprInstr platform instr = case instr of LDR _f o1@(OpReg W16 (RegReal (RealRegSingle i))) o2 | i < 32 -> op2 (text "\tldrh") o1 o2 LDR _f o1 o2 -> op2 (text "\tldr") o1 o2 + LDAR _f o1 o2 -> op2 (text "\tldar") o1 o2 STP _f o1 o2 o3 -> op3 (text "\tstp") o1 o2 o3 LDP _f o1 o2 o3 -> op3 (text "\tldp") o1 o2 o3 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/759304244f15992a098a924ebd93f295971da422 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/759304244f15992a098a924ebd93f295971da422 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 16:31:30 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 14 Feb 2023 11:31:30 -0500 Subject: [Git][ghc/ghc][master] Fix some correctness issues around tag inference when targeting the bytecode generator. Message-ID: <63ebb76264e63_26da8449bc608909276@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9 changed files: - compiler/GHC/Driver/Config/Stg/Pipeline.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Types.hs - compiler/GHC/Stg/Pipeline.hs - + testsuite/tests/simplStg/should_compile/T22840.hs - + testsuite/tests/simplStg/should_compile/T22840.stderr - + testsuite/tests/simplStg/should_compile/T22840A.hs - + testsuite/tests/simplStg/should_compile/T22840B.hs - testsuite/tests/simplStg/should_compile/all.T Changes: ===================================== compiler/GHC/Driver/Config/Stg/Pipeline.hs ===================================== @@ -22,6 +22,7 @@ initStgPipelineOpts dflags for_bytecode = StgPipelineOpts , stgPipeline_pprOpts = initStgPprOpts dflags , stgPipeline_phases = getStgToDo for_bytecode dflags , stgPlatform = targetPlatform dflags + , stgPipeline_forBytecode = for_bytecode } -- | Which Stg-to-Stg passes to run. Depends on flags, ways etc. ===================================== compiler/GHC/Stg/InferTags.hs ===================================== @@ -204,6 +204,33 @@ a different StgPass! To handle this a large part of the analysis is polymorphic over the exact StgPass we are using. Which allows us to run the analysis on the output of itself. +Note [Tag inference for interpreted code] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The bytecode interpreter has a different behaviour when it comes +to the tagging of binders in certain situations than the StgToCmm code generator. + +a) Tags for let-bindings: + + When compiling a binding for a constructor like `let x = Just True` + Whether `x` will be properly tagged depends on the backend. + For the interpreter x points to a BCO which once + evaluated returns a properly tagged pointer to the heap object. + In the Cmm backend for the same binding we would allocate the constructor right + away and x will immediately be represented by a tagged pointer. + This means for interpreted code we can not assume let bound constructors are + properly tagged. Hence we distinguish between targeting bytecode and native in + the analysis. + We make this differentiation in `mkLetSig` where we simply never assume + lets are tagged when targeting bytecode. + +b) When referencing ids from other modules the Cmm backend will try to put a + proper tag on these references through various means. When doing analysis we + usually predict these cases to improve precision of the analysis. + But to my knowledge the bytecode generator makes no such attempts so we must + not infer imported bindings as tagged. + This is handled in GHC.Stg.InferTags.Types.lookupInfo + + -} {- ********************************************************************* @@ -212,20 +239,12 @@ the output of itself. * * ********************************************************************* -} --- doCodeGen :: HscEnv -> Module -> InfoTableProvMap -> [TyCon] --- -> CollectedCCs --- -> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs --- -> HpcInfo --- -> IO (Stream IO CmmGroupSRTs CmmCgInfos) --- -- Note we produce a 'Stream' of CmmGroups, so that the --- -- backend can be run incrementally. Otherwise it generates all --- -- the C-- up front, which has a significant space cost. -inferTags :: StgPprOpts -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) -inferTags ppr_opts logger this_mod stg_binds = do - +inferTags :: StgPprOpts -> Bool -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) +inferTags ppr_opts !for_bytecode logger this_mod stg_binds = do + -- pprTraceM "inferTags for " (ppr this_mod <> text " bytecode:" <> ppr for_bytecode) -- Annotate binders with tag information. let (!stg_binds_w_tags) = {-# SCC "StgTagFields" #-} - inferTagsAnal stg_binds + inferTagsAnal for_bytecode stg_binds putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings ppr_opts stg_binds_w_tags) let export_tag_info = collectExportInfo stg_binds_w_tags @@ -254,10 +273,10 @@ type InferExtEq i = ( XLet i ~ XLet 'InferTaggedBinders , XLetNoEscape i ~ XLetNoEscape 'InferTaggedBinders , XRhsClosure i ~ XRhsClosure 'InferTaggedBinders) -inferTagsAnal :: [GenStgTopBinding 'CodeGen] -> [GenStgTopBinding 'InferTaggedBinders] -inferTagsAnal binds = +inferTagsAnal :: Bool -> [GenStgTopBinding 'CodeGen] -> [GenStgTopBinding 'InferTaggedBinders] +inferTagsAnal for_bytecode binds = -- pprTrace "Binds" (pprGenStgTopBindings shortStgPprOpts $ binds) $ - snd (mapAccumL inferTagTopBind initEnv binds) + snd (mapAccumL inferTagTopBind (initEnv for_bytecode) binds) ----------------------- inferTagTopBind :: TagEnv 'CodeGen -> GenStgTopBinding 'CodeGen @@ -420,11 +439,12 @@ inferTagBind in_env (StgNonRec bndr rhs) -- ppr bndr $$ -- ppr (isDeadEndId id) $$ -- ppr sig) - (env', StgNonRec (id, sig) rhs') + (env', StgNonRec (id, out_sig) rhs') where id = getBinderId in_env bndr - env' = extendSigEnv in_env [(id, sig)] - (sig,rhs') = inferTagRhs id in_env rhs + (in_sig,rhs') = inferTagRhs id in_env rhs + out_sig = mkLetSig in_env in_sig + env' = extendSigEnv in_env [(id, out_sig)] inferTagBind in_env (StgRec pairs) = -- pprTrace "rec" (ppr (map fst pairs) $$ ppr (in_env { te_env = out_env }, StgRec pairs')) $ @@ -443,14 +463,17 @@ inferTagBind in_env (StgRec pairs) | in_sigs == out_sigs = (te_env rhs_env, out_bndrs `zip` rhss') | otherwise = go env' out_sigs rhss' where - out_bndrs = map updateBndr in_bndrs -- TODO: Keeps in_ids alive in_bndrs = in_ids `zip` in_sigs + out_bndrs = map updateBndr in_bndrs -- TODO: Keeps in_ids alive rhs_env = extendSigEnv go_env in_bndrs (out_sigs, rhss') = unzip (zipWithEqual "inferTagBind" anaRhs in_ids go_rhss) env' = makeTagged go_env anaRhs :: Id -> GenStgRhs q -> (TagSig, GenStgRhs 'InferTaggedBinders) - anaRhs bnd rhs = inferTagRhs bnd rhs_env rhs + anaRhs bnd rhs = + let (sig_rhs,rhs') = inferTagRhs bnd rhs_env rhs + in (mkLetSig go_env sig_rhs, rhs') + updateBndr :: (Id,TagSig) -> (Id,TagSig) updateBndr (v,sig) = (setIdTagSig v sig, sig) @@ -536,6 +559,15 @@ inferTagRhs _ env _rhs@(StgRhsCon cc con cn ticks args) = --pprTrace "inferTagRhsCon" (ppr grp_ids) $ (TagSig (inferConTag env con args), StgRhsCon cc con cn ticks args) +-- Adjust let semantics to the targeted backend. +-- See Note [Tag inference for interpreted code] +mkLetSig :: TagEnv p -> TagSig -> TagSig +mkLetSig env in_sig + | for_bytecode = TagSig TagDunno + | otherwise = in_sig + where + for_bytecode = te_bytecode env + {- Note [Constructor TagSigs] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @inferConTag@ will infer the proper tag signature for a binding who's RHS is a constructor ===================================== compiler/GHC/Stg/InferTags/Types.hs ===================================== @@ -49,24 +49,30 @@ combineAltInfo ti TagTagged = ti type TagSigEnv = IdEnv TagSig data TagEnv p = TE { te_env :: TagSigEnv , te_get :: BinderP p -> Id + , te_bytecode :: !Bool } instance Outputable (TagEnv p) where - ppr te = ppr (te_env te) - + ppr te = for_txt <+> ppr (te_env te) + where + for_txt = if te_bytecode te + then text "for_bytecode" + else text "for_native" getBinderId :: TagEnv p -> BinderP p -> Id getBinderId = te_get -initEnv :: TagEnv 'CodeGen -initEnv = TE { te_env = emptyVarEnv - , te_get = \x -> x} +initEnv :: Bool -> TagEnv 'CodeGen +initEnv for_bytecode = TE { te_env = emptyVarEnv + , te_get = \x -> x + , te_bytecode = for_bytecode } -- | Simple convert env to a env of the 'InferTaggedBinders pass -- with no other changes. makeTagged :: TagEnv p -> TagEnv 'InferTaggedBinders makeTagged env = TE { te_env = te_env env - , te_get = fst } + , te_get = fst + , te_bytecode = te_bytecode env } noSig :: TagEnv p -> BinderP p -> (Id, TagSig) noSig env bndr @@ -75,14 +81,18 @@ noSig env bndr where var = getBinderId env bndr +-- | Look up a sig in the given env lookupSig :: TagEnv p -> Id -> Maybe TagSig lookupSig env fun = lookupVarEnv (te_env env) fun +-- | Look up a sig in the env or derive it from information +-- in the arg itself. lookupInfo :: TagEnv p -> StgArg -> TagInfo lookupInfo env (StgVarArg var) -- Nullary data constructors like True, False | Just dc <- isDataConWorkId_maybe var , isNullaryRepDataCon dc + , not for_bytecode = TagProper | isUnliftedType (idType var) @@ -93,6 +103,7 @@ lookupInfo env (StgVarArg var) = info | Just lf_info <- idLFInfo_maybe var + , not for_bytecode = case lf_info of -- Function, tagged (with arity) LFReEntrant {} @@ -112,6 +123,8 @@ lookupInfo env (StgVarArg var) | otherwise = TagDunno + where + for_bytecode = te_bytecode env lookupInfo _ (StgLitArg {}) = TagProper ===================================== compiler/GHC/Stg/Pipeline.hs ===================================== @@ -50,6 +50,7 @@ data StgPipelineOpts = StgPipelineOpts -- ^ Should we lint the STG at various stages of the pipeline? , stgPipeline_pprOpts :: !StgPprOpts , stgPlatform :: !Platform + , stgPipeline_forBytecode :: !Bool } newtype StgM a = StgM { _unStgM :: ReaderT Char IO a } @@ -89,7 +90,7 @@ stg2stg logger extra_vars opts this_mod binds -- annotations (which is used by code generator to compute offsets into closures) ; let binds_sorted_with_fvs = depSortWithAnnotStgPgm this_mod binds' -- See Note [Tag inference for interactive contexts] - ; inferTags (stgPipeline_pprOpts opts) logger this_mod binds_sorted_with_fvs + ; inferTags (stgPipeline_pprOpts opts) (stgPipeline_forBytecode opts) logger this_mod binds_sorted_with_fvs } where ===================================== testsuite/tests/simplStg/should_compile/T22840.hs ===================================== @@ -0,0 +1,14 @@ +{-# OPTIONS_GHC -fwrite-if-simplified-core -fbyte-code-and-object-code -fprefer-byte-code #-} +{-# LANGUAGE TemplateHaskell #-} + +module C where + +import T22840A +import T22840B +import Control.Monad.IO.Class + +$(liftIO $ do + putStrLn "start" + putStrLn (disp theT) + putStrLn "end" + return []) ===================================== testsuite/tests/simplStg/should_compile/T22840.stderr ===================================== @@ -0,0 +1,6 @@ +[1 of 3] Compiling T22840A ( T22840A.hs, T22840A.o, T22840A.dyn_o ) +[2 of 3] Compiling T22840B ( T22840B.hs, T22840B.o, T22840B.dyn_o, interpreted ) +[3 of 3] Compiling C ( T22840.hs, T22840.o, T22840.dyn_o, interpreted ) +start +Just +end ===================================== testsuite/tests/simplStg/should_compile/T22840A.hs ===================================== @@ -0,0 +1,9 @@ +module T22840A where + +data T = MkT !(Maybe Bool) + +disp :: T -> String +disp (MkT b) = + case b of + Nothing -> "Nothing" + Just _ -> "Just" ===================================== testsuite/tests/simplStg/should_compile/T22840B.hs ===================================== @@ -0,0 +1,8 @@ +{-# OPTIONS_GHC -fwrite-if-simplified-core -fbyte-code-and-object-code -fprefer-byte-code #-} + +module T22840B where + +import T22840A + +theT :: T +theT = MkT (Just True) ===================================== testsuite/tests/simplStg/should_compile/all.T ===================================== @@ -14,3 +14,7 @@ test('T19717', normal, compile, ['-ddump-stg-final -dsuppress-uniques -dno-typea test('inferTags002', [ only_ways(['optasm']), grep_errmsg(r'(call stg\_ap\_0)', [1])], compile, ['-ddump-cmm -dsuppress-uniques -dno-typeable-binds -O']) test('T22212', normal, compile, ['-O']) +test('T22840', [extra_files( + [ 'T22840A.hs' + , 'T22840B.hs' + ]), when(not(have_dynamic()),skip)], multimod_compile, ['T22840', '-dynamic-too -dtag-inference-checks']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d6411d6cddb8c94c74e5834f0199370d189d31a2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d6411d6cddb8c94c74e5834f0199370d189d31a2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 16:32:30 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 14 Feb 2023 11:32:30 -0500 Subject: [Git][ghc/ghc][master] Introduce warning for loopy superclass solve Message-ID: <63ebb79e5aa32_26da84c2ec974918699@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 26 changed files: - compiler/GHC/Driver/Flags.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Origin.hs-boot - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/using-warnings.rst - testsuite/tests/quantified-constraints/all.T - + testsuite/tests/typecheck/should_compile/T20666b.hs - + testsuite/tests/typecheck/should_compile/T20666b.stderr - + testsuite/tests/typecheck/should_compile/T22891.hs - + testsuite/tests/typecheck/should_compile/T22891.stderr - + testsuite/tests/typecheck/should_compile/T22912.hs - + testsuite/tests/typecheck/should_compile/T22912.stderr - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_fail/T20666.stderr - testsuite/tests/typecheck/should_fail/T20666a.stderr - testsuite/tests/typecheck/should_fail/T6161.stderr - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/tcfail223.stderr Changes: ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -631,6 +631,7 @@ data WarningFlag = | Opt_WarnGADTMonoLocalBinds -- Since 9.4 | Opt_WarnTypeEqualityOutOfScope -- Since 9.4 | Opt_WarnTypeEqualityRequiresOperators -- Since 9.4 + | Opt_WarnLoopySuperclassSolve -- Since 9.6 | Opt_WarnTermVariableCapture -- Since 9.8 deriving (Eq, Ord, Show, Enum) @@ -737,6 +738,7 @@ warnFlagNames wflag = case wflag of Opt_WarnUnicodeBidirectionalFormatCharacters -> "unicode-bidirectional-format-characters" :| [] Opt_WarnGADTMonoLocalBinds -> "gadt-mono-local-binds" :| [] Opt_WarnTypeEqualityOutOfScope -> "type-equality-out-of-scope" :| [] + Opt_WarnLoopySuperclassSolve -> "loopy-superclass-solve" :| [] Opt_WarnTypeEqualityRequiresOperators -> "type-equality-requires-operators" :| [] -- ----------------------------------------------------------------------------- @@ -853,6 +855,7 @@ standardWarnings -- see Note [Documenting warning flags] Opt_WarnForallIdentifier, Opt_WarnUnicodeBidirectionalFormatCharacters, Opt_WarnGADTMonoLocalBinds, + Opt_WarnLoopySuperclassSolve, Opt_WarnTypeEqualityRequiresOperators ] ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -8,6 +8,7 @@ {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- instance Diagnostic TcRnMessage +{-# LANGUAGE InstanceSigs #-} module GHC.Tc.Errors.Ppr ( pprTypeDoesNotHaveFixedRuntimeRep @@ -1305,7 +1306,18 @@ instance Diagnostic TcRnMessage where , text "Combine alternative minimal complete definitions with `|'" ] where sigs = sig1 : sig2 : otherSigs - + TcRnLoopySuperclassSolve wtd_loc wtd_pty -> + mkSimpleDecorated $ vcat [ header, warning, user_manual ] + where + header, warning, user_manual :: SDoc + header + = vcat [ text "I am solving the constraint" <+> quotes (ppr wtd_pty) <> comma + , nest 2 $ pprCtOrigin (ctLocOrigin wtd_loc) <> comma + , text "in a way that might turn out to loop at runtime." ] + warning + = vcat [ text "Future versions of GHC will turn this warning into an error." ] + user_manual = + vcat [ text "See the user manual, § Undecidable instances and loopy superclasses." ] diagnosticReason = \case TcRnUnknownMessage m @@ -1734,6 +1746,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnDuplicateMinimalSig{} -> ErrorWithoutFlag + TcRnLoopySuperclassSolve{} + -> WarningWithFlag Opt_WarnLoopySuperclassSolve diagnosticHints = \case TcRnUnknownMessage m @@ -2173,6 +2187,13 @@ instance Diagnostic TcRnMessage where -> noHints TcRnDuplicateMinimalSig{} -> noHints + TcRnLoopySuperclassSolve wtd_loc wtd_pty + -> [LoopySuperclassSolveHint wtd_pty cls_or_qc] + where + cls_or_qc :: ClsInstOrQC + cls_or_qc = case ctLocOrigin wtd_loc of + ScOrigin c_or_q _ -> c_or_q + _ -> IsClsInst -- shouldn't happen diagnosticCode = constructorCode ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -2924,6 +2924,23 @@ data TcRnMessage where -} TcRnDuplicateMinimalSig :: LSig GhcPs -> LSig GhcPs -> [LSig GhcPs] -> TcRnMessage + {-| TcRnLoopySuperclassSolve is a warning, controlled by @-Wloopy-superclass-solve@, + that is triggered when GHC solves a constraint in a possibly-loopy way, + violating the class instance termination rules described in the section + "Undecidable instances and loopy superclasses" of the user's guide. + + Example: + + class Foo f + class Foo f => Bar f g + instance Bar f f => Bar f (h k) + + Test cases: T20666, T20666{a,b}, T22891, T22912. + -} + TcRnLoopySuperclassSolve :: CtLoc -- ^ Wanted 'CtLoc' + -> PredType -- ^ Wanted 'PredType' + -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. ===================================== compiler/GHC/Tc/Solver/InertSet.hs ===================================== @@ -1633,10 +1633,17 @@ mightEqualLater inert_set given_pred given_loc wanted_pred wanted_loc = False can_unify lhs_tv _other _rhs_ty = mentions_meta_ty_var lhs_tv -prohibitedSuperClassSolve :: CtLoc -- ^ is it loopy to use this one ... - -> CtLoc -- ^ ... to solve this one? - -> Bool -- ^ True ==> don't solve it --- See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance, (sc2) +-- | Is it (potentially) loopy to use the first @ct1@ to solve @ct2@? +-- +-- Necessary (but not sufficient) conditions for this function to return @True@: +-- +-- - @ct1@ and @ct2@ both arise from superclass expansion, +-- - @ct1@ is a Given and @ct2@ is a Wanted. +-- +-- See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance, (sc2). +prohibitedSuperClassSolve :: CtLoc -- ^ is it loopy to use this one ... + -> CtLoc -- ^ ... to solve this one? + -> Bool -- ^ True ==> don't solve it prohibitedSuperClassSolve given_loc wanted_loc | GivenSCOrigin _ _ blocked <- ctLocOrigin given_loc , blocked ===================================== compiler/GHC/Tc/Solver/Interact.hs ===================================== @@ -449,7 +449,7 @@ instance Outputable InteractResult where solveOneFromTheOther :: Ct -- Inert (Dict or Irred) -> Ct -- WorkItem (same predicate as inert) - -> TcS InteractResult + -> InteractResult -- Precondition: -- * inert and work item represent evidence for the /same/ predicate -- * Both are CDictCan or CIrredCan @@ -461,28 +461,28 @@ solveOneFromTheOther :: Ct -- Inert (Dict or Irred) solveOneFromTheOther ct_i ct_w | CtWanted { ctev_loc = loc_w } <- ev_w , prohibitedSuperClassSolve loc_i loc_w + -- See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance = -- Inert must be Given - do { traceTcS "prohibitedClassSolve1" (ppr ev_i $$ ppr ev_w) - ; return KeepWork } + KeepWork | CtWanted {} <- ev_w = -- Inert is Given or Wanted case ev_i of - CtGiven {} -> return KeepInert + CtGiven {} -> KeepInert -- work is Wanted; inert is Given: easy choice. CtWanted {} -- Both are Wanted -- If only one has no pending superclasses, use it -- Otherwise we can get infinite superclass expansion (#22516) -- in silly cases like class C T b => C a b where ... - | not is_psc_i, is_psc_w -> return KeepInert - | is_psc_i, not is_psc_w -> return KeepWork + | not is_psc_i, is_psc_w -> KeepInert + | is_psc_i, not is_psc_w -> KeepWork -- If only one is a WantedSuperclassOrigin (arising from expanding -- a Wanted class constraint), keep the other: wanted superclasses -- may be unexpected by users - | not is_wsc_orig_i, is_wsc_orig_w -> return KeepInert - | is_wsc_orig_i, not is_wsc_orig_w -> return KeepWork + | not is_wsc_orig_i, is_wsc_orig_w -> KeepInert + | is_wsc_orig_i, not is_wsc_orig_w -> KeepWork -- otherwise, just choose the lower span -- reason: if we have something like (abs 1) (where the @@ -490,29 +490,28 @@ solveOneFromTheOther ct_i ct_w -- get an error about abs than about 1. -- This test might become more elaborate if we see an -- opportunity to improve the error messages - | ((<) `on` ctLocSpan) loc_i loc_w -> return KeepInert - | otherwise -> return KeepWork + | ((<) `on` ctLocSpan) loc_i loc_w -> KeepInert + | otherwise -> KeepWork -- From here on the work-item is Given | CtWanted { ctev_loc = loc_i } <- ev_i , prohibitedSuperClassSolve loc_w loc_i - = do { traceTcS "prohibitedClassSolve2" (ppr ev_i $$ ppr ev_w) - ; return KeepInert } -- Just discard the un-usable Given - -- This never actually happens because - -- Givens get processed first + = KeepInert -- Just discard the un-usable Given + -- This never actually happens because + -- Givens get processed first | CtWanted {} <- ev_i - = return KeepWork + = KeepWork -- From here on both are Given -- See Note [Replacement vs keeping] | lvl_i == lvl_w - = return same_level_strategy + = same_level_strategy | otherwise -- Both are Given, levels differ - = return different_level_strategy + = different_level_strategy where ev_i = ctEvidence ct_i ev_w = ctEvidence ct_w @@ -662,14 +661,12 @@ interactIrred inerts ct_w@(CIrredCan { cc_ev = ev_w, cc_reason = reason }) , ((ct_i, swap) : _rest) <- bagToList matching_irreds -- See Note [Multiple matching irreds] , let ev_i = ctEvidence ct_i - = do { what_next <- solveOneFromTheOther ct_i ct_w - ; traceTcS "iteractIrred" $ + = do { traceTcS "iteractIrred" $ vcat [ text "wanted:" <+> (ppr ct_w $$ ppr (ctOrigin ct_w)) - , text "inert: " <+> (ppr ct_i $$ ppr (ctOrigin ct_i)) - , ppr what_next ] - ; case what_next of + , text "inert: " <+> (ppr ct_i $$ ppr (ctOrigin ct_i)) ] + ; case solveOneFromTheOther ct_i ct_w of KeepInert -> do { setEvBindIfWanted ev_w (swap_me swap ev_i) - ; return (Stop ev_w (text "Irred equal" <+> parens (ppr what_next))) } + ; return (Stop ev_w (text "Irred equal:KeepInert" <+> ppr ct_w)) } KeepWork -> do { setEvBindIfWanted ev_i (swap_me swap ev_w) ; updInertIrreds (\_ -> others) ; continueWith ct_w } } @@ -1007,7 +1004,9 @@ and Given/instance fundeps entirely. interactDict :: InertCans -> Ct -> TcS (StopOrContinue Ct) interactDict inerts ct_w@(CDictCan { cc_ev = ev_w, cc_class = cls, cc_tyargs = tys }) | Just ct_i <- lookupInertDict inerts (ctEvLoc ev_w) cls tys - , let ev_i = ctEvidence ct_i + , let ev_i = ctEvidence ct_i + loc_i = ctEvLoc ev_i + loc_w = ctEvLoc ev_w = -- There is a matching dictionary in the inert set do { -- First to try to solve it /completely/ from top level instances -- See Note [Shortcut solving] @@ -1015,16 +1014,24 @@ interactDict inerts ct_w@(CDictCan { cc_ev = ev_w, cc_class = cls, cc_tyargs = t ; short_cut_worked <- shortCutSolver dflags ev_w ev_i ; if short_cut_worked then stopWith ev_w "interactDict/solved from instance" - else - do { -- Ths short-cut solver didn't fire, so we - -- solve ev_w from the matching inert ev_i we found - what_next <- solveOneFromTheOther ct_i ct_w - ; traceTcS "lookupInertDict" (ppr what_next) - ; case what_next of - KeepInert -> do { setEvBindIfWanted ev_w (ctEvTerm ev_i) - ; return $ Stop ev_w (text "Dict equal" <+> parens (ppr what_next)) } - KeepWork -> do { setEvBindIfWanted ev_i (ctEvTerm ev_w) + -- Next see if we are in "loopy-superclass" land. If so, + -- we don't want to replace the (Given) inert with the + -- (Wanted) work-item, or vice versa; we want to hang on + -- to both, and try to solve the work-item via an instance. + -- See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance + else if prohibitedSuperClassSolve loc_i loc_w + then continueWith ct_w + else + do { -- The short-cut solver didn't fire, and loopy superclasses + -- are dealt with, so we can either solve + -- the inert from the work-item or vice-versa. + ; case solveOneFromTheOther ct_i ct_w of + KeepInert -> do { traceTcS "lookupInertDict:KeepInert" (ppr ct_w) + ; setEvBindIfWanted ev_w (ctEvTerm ev_i) + ; return $ Stop ev_w (text "Dict equal" <+> ppr ct_w) } + KeepWork -> do { traceTcS "lookupInertDict:KeepWork" (ppr ct_w) + ; setEvBindIfWanted ev_i (ctEvTerm ev_w) ; updInertDicts $ \ ds -> delDict ds cls tys ; continueWith ct_w } } } @@ -1894,7 +1901,7 @@ as the fundeps. #7875 is a case in point. -} -doTopFundepImprovement :: Ct -> TcS (StopOrContinue Ct) +doTopFundepImprovement :: Ct -> TcS () -- Try to functional-dependency improvement between the constraint -- and the top-level instance declarations -- See Note [Fundeps with instances, and equality orientation] @@ -1904,8 +1911,7 @@ doTopFundepImprovement work_item@(CDictCan { cc_ev = ev, cc_class = cls = do { traceTcS "try_fundeps" (ppr work_item) ; instEnvs <- getInstEnvs ; let fundep_eqns = improveFromInstEnv instEnvs mk_ct_loc cls xis - ; emitFunDepWanteds (ctEvRewriters ev) fundep_eqns - ; continueWith work_item } + ; emitFunDepWanteds (ctEvRewriters ev) fundep_eqns } where dict_pred = mkClassPred cls xis dict_loc = ctEvLoc ev @@ -2276,14 +2282,35 @@ doTopReactDict inerts work_item@(CDictCan { cc_ev = ev, cc_class = cls ; chooseInstance work_item lkup_res } _ -> -- NoInstance or NotSure -- We didn't solve it; so try functional dependencies with - -- the instance environment, and return - doTopFundepImprovement work_item } + -- the instance environment + do { doTopFundepImprovement work_item + ; tryLastResortProhibitedSuperclass inerts work_item } } where dict_loc = ctEvLoc ev doTopReactDict _ w = pprPanic "doTopReactDict" (ppr w) +-- | As a last resort, we TEMPORARILY allow a prohibited superclass solve, +-- emitting a loud warning when doing so: we might be creating non-terminating +-- evidence (as we are in T22912 for example). +-- +-- See Note [Migrating away from loopy superclass solving] in GHC.Tc.TyCl.Instance. +tryLastResortProhibitedSuperclass :: InertSet -> Ct -> TcS (StopOrContinue Ct) +tryLastResortProhibitedSuperclass inerts + work_item@(CDictCan { cc_ev = ev_w, cc_class = cls, cc_tyargs = xis }) + | let loc_w = ctEvLoc ev_w + orig_w = ctLocOrigin loc_w + , ScOrigin _ NakedSc <- orig_w -- work_item is definitely Wanted + , Just ct_i <- lookupInertDict (inert_cans inerts) loc_w cls xis + , let ev_i = ctEvidence ct_i + , isGiven ev_i + = do { setEvBindIfWanted ev_w (ctEvTerm ev_i) + ; ctLocWarnTcS loc_w $ + TcRnLoopySuperclassSolve loc_w (ctPred work_item) + ; return $ Stop ev_w (text "Loopy superclass") } +tryLastResortProhibitedSuperclass _ work_item + = continueWith work_item chooseInstance :: Ct -> ClsInstResult -> TcS (StopOrContinue Ct) chooseInstance work_item ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -15,7 +15,7 @@ module GHC.Tc.Solver.Monad ( -- The TcS monad TcS, runTcS, runTcSEarlyAbort, runTcSWithEvBinds, runTcSInerts, - failTcS, warnTcS, addErrTcS, wrapTcS, + failTcS, warnTcS, addErrTcS, wrapTcS, ctLocWarnTcS, runTcSEqualities, nestTcS, nestImplicTcS, setEvBindsTcS, emitImplicationTcS, emitTvImplicationTcS, @@ -673,16 +673,18 @@ lookupInInerts :: CtLoc -> TcPredType -> TcS (Maybe CtEvidence) lookupInInerts loc pty | ClassPred cls tys <- classifyPredType pty = do { inerts <- getTcSInerts - ; return $ -- Maybe monad - do { found_ev <- - lookupSolvedDict inerts loc cls tys `mplus` - fmap ctEvidence (lookupInertDict (inert_cans inerts) loc cls tys) - ; guard (not (prohibitedSuperClassSolve (ctEvLoc found_ev) loc)) - -- We're about to "solve" the wanted we're looking up, so we - -- must make sure doing so wouldn't run afoul of - -- Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance. - -- Forgetting this led to #20666. - ; return found_ev }} + ; let mb_solved = lookupSolvedDict inerts loc cls tys + mb_inert = fmap ctEvidence (lookupInertDict (inert_cans inerts) loc cls tys) + ; return $ do -- Maybe monad + found_ev <- mb_solved `mplus` mb_inert + + -- We're about to "solve" the wanted we're looking up, so we + -- must make sure doing so wouldn't run afoul of + -- Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance. + -- Forgetting this led to #20666. + guard $ not (prohibitedSuperClassSolve (ctEvLoc found_ev) loc) + + return found_ev } | otherwise -- NB: No caching for equalities, IPs, holes, or errors = return Nothing @@ -855,6 +857,10 @@ warnTcS msg = wrapTcS (TcM.addDiagnostic msg) addErrTcS = wrapTcS . TcM.addErr panicTcS doc = pprPanic "GHC.Tc.Solver.Canonical" doc +-- | Emit a warning within the 'TcS' monad at the location given by the 'CtLoc'. +ctLocWarnTcS :: CtLoc -> TcRnMessage -> TcS () +ctLocWarnTcS loc msg = wrapTcS $ TcM.setCtLocM loc $ TcM.addDiagnostic msg + traceTcS :: String -> SDoc -> TcS () traceTcS herald doc = wrapTcS (TcM.traceTc herald doc) {-# INLINE traceTcS #-} -- see Note [INLINE conditional tracing utilities] ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -1661,6 +1661,20 @@ Answer: superclass selection, except at a smaller type. This test is implemented by GHC.Tc.Solver.InertSet.prohibitedSuperClassSolve +Note [Migrating away from loopy superclass solving] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The logic from Note [Solving superclass constraints] was implemented in GHC 9.6. +However, we want to provide a migration strategy for users, to avoid suddenly +breaking their code going when upgrading to GHC 9.6. To this effect, we temporarily +continue to allow the constraint solver to create these potentially non-terminating +solutions, but emit a loud warning when doing so: see +GHC.Tc.Solver.Interact.tryLastResortProhibitedSuperclass. + +Users can silence the warning by manually adding the necessary constraint to the +context. GHC will then keep this user-written Given, dropping the Given arising +from superclass expansion which has greater SC depth, as explained in +Note [Replacement vs keeping] in GHC.Tc.Solver.Interact. + Note [Silent superclass arguments] (historical interest only) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ NB1: this note describes our *old* solution to the ===================================== compiler/GHC/Tc/Types/Origin.hs-boot ===================================== @@ -7,4 +7,8 @@ data SkolemInfo data FixedRuntimeRepContext data FixedRuntimeRepOrigin +data CtOrigin +data ClsInstOrQC = IsClsInst + | IsQC CtOrigin + unkSkol :: HasCallStack => SkolemInfo ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -512,6 +512,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnUnexpectedDefaultSig" = 40700 GhcDiagnosticCode "TcRnBindInBootFile" = 11247 GhcDiagnosticCode "TcRnDuplicateMinimalSig" = 85346 + GhcDiagnosticCode "TcRnLoopySuperclassSolve" = 36038 -- IllegalNewtypeReason GhcDiagnosticCode "DoesNotHaveSingleField" = 23517 ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -32,11 +32,13 @@ import GHC.Unit.Module (ModuleName, Module) import GHC.Hs.Extension (GhcTc) import GHC.Core.Coercion import GHC.Core.FamInstEnv (FamFlavor) +import GHC.Core.Type (PredType) import GHC.Types.Fixity (LexicalFixity(..)) import GHC.Types.Name (Name, NameSpace, OccName (occNameFS), isSymOcc, nameOccName) import GHC.Types.Name.Reader (RdrName (Unqual), ImpDeclSpec) import GHC.Types.SrcLoc (SrcSpan) import GHC.Types.Basic (Activation, RuleName) +import {-# SOURCE #-} GHC.Tc.Types.Origin ( ClsInstOrQC(..) ) import GHC.Parser.Errors.Basic import {-# SOURCE #-} Language.Haskell.Syntax.Expr import GHC.Unit.Module.Imported (ImportedModsVal) @@ -429,6 +431,8 @@ data GhcHint -} | SuggestRenameTypeVariable + | LoopySuperclassSolveHint PredType ClsInstOrQC + -- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated -- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way -- to instantiate a particular signature, where the first argument is ===================================== compiler/GHC/Types/Hint/Ppr.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Types.Hint import GHC.Core.FamInstEnv (FamFlavor(..)) import GHC.Hs.Expr () -- instance Outputable +import {-# SOURCE #-} GHC.Tc.Types.Origin ( ClsInstOrQC(..) ) import GHC.Types.Id import GHC.Types.Name (NameSpace, pprDefinedAt, occNameSpace, pprNameSpace, isValNameSpace, nameModule) import GHC.Types.Name.Reader (RdrName,ImpDeclSpec (..), rdrNameOcc, rdrNameSpace) @@ -214,6 +215,14 @@ instance Outputable GhcHint where mod = nameModule name SuggestRenameTypeVariable -> text "Consider renaming the type variable." + LoopySuperclassSolveHint pty cls_or_qc + -> vcat [ text "Add the constraint" <+> quotes (ppr pty) <+> text "to the" <+> what <> comma + , text "even though it seems logically implied by other constraints in the context." ] + where + what :: SDoc + what = case cls_or_qc of + IsClsInst -> text "instance context" + IsQC {} -> text "context of the quantified constraint" perhapsAsPat :: SDoc perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace" ===================================== docs/users_guide/9.6.1-notes.rst ===================================== @@ -3,10 +3,36 @@ Version 9.6.1 ============== - Language ~~~~~~~~ +- GHC is now more conservative when solving constraints that arise from + superclass expansion in terms of other constraints that also arise from + superclass expansion. + + For example: :: + + class C a + class C a => D a b + instance D a a => D a b + + When typechecking the instance, we need to also solve the constraints arising + from the superclasses of ``D``; in this case, we need ``C a``. We could obtain + evidence for this constraint by expanding the superclasses of the context, + as ``D a a`` also has a superclass context of ``C a``. + However, is it unsound to do so in general, as we might be assuming precisely + the predicate we want to prove! This can lead to programs that loop at runtime. + + When such potentially-loopy situations arise, GHC now emits a warning. + In future releases, this behaviour will no longer be supported, and the + typechecker will outright refuse to solve these constraints, emitting a + ``Could not deduce`` error. + + In practice, you should be able to fix these issues by adding the necessary + constraint to the context, e.g. for the above example: :: + + instance (C a, D a a) => D a b + - Record updates for GADTs and other existential datatypes are now fully supported. ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -2319,6 +2319,22 @@ of ``-W(no-)*``. triggered whenever this happens, and can be addressed by enabling the extension. +.. ghc-flag:: -Wloopy-superclass-solve + :shortdesc: warn when creating potentially-loopy superclass constraint evidence + :type: dynamic + :reverse: -Wno-loopy-superclass-solve + + :since: 9.6.1 + + As explained in :ref:`undecidable_instances`, when using + :extension:`UndecidableInstances` it is possible for GHC to construct + non-terminating evidence for certain superclass constraints. + + This behaviour is scheduled to be removed in a future GHC version. + In the meantime, GHC emits this warning to inform users of potential + non-termination. Users can manually add the required constraint to the context + to avoid the problem (thus silencing the warning). + .. ghc-flag:: -Wterm-variable-capture :shortdesc: warn when an implicitly quantified type variable captures a term's name :type: dynamic ===================================== testsuite/tests/quantified-constraints/all.T ===================================== @@ -41,3 +41,4 @@ test('T22216d', normal, compile, ['']) test('T22216e', normal, compile, ['']) test('T22223', normal, compile, ['']) test('T19690', normal, compile_fail, ['']) + ===================================== testsuite/tests/typecheck/should_compile/T20666b.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE TypeFamilies #-} + +module T20666b where + +type family F a + +class Eq (F a) => D a +class Eq (F a) => C a + +instance D [a] => C [a] + ===================================== testsuite/tests/typecheck/should_compile/T20666b.stderr ===================================== @@ -0,0 +1,10 @@ + +T20666b.hs:11:10: warning: [GHC-36038] [-Wloopy-superclass-solve (in -Wdefault)] + I am solving the constraint ‘Eq (F [a])’, + arising from the superclasses of an instance declaration, + in a way that might turn out to loop at runtime. + Future versions of GHC will turn this warning into an error. + See the user manual, § Undecidable instances and loopy superclasses. + Suggested fix: + Add the constraint ‘Eq (F [a])’ to the instance context, + even though it seems logically implied by other constraints in the context. ===================================== testsuite/tests/typecheck/should_compile/T22891.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE UndecidableInstances #-} + +module T22891 where + +class Foo f + +class Foo f => Bar f g + +instance Bar f f => Bar f (h k) ===================================== testsuite/tests/typecheck/should_compile/T22891.stderr ===================================== @@ -0,0 +1,10 @@ + +T22891.hs:9:10: warning: [GHC-36038] [-Wloopy-superclass-solve (in -Wdefault)] + I am solving the constraint ‘Foo f’, + arising from the superclasses of an instance declaration, + in a way that might turn out to loop at runtime. + Future versions of GHC will turn this warning into an error. + See the user manual, § Undecidable instances and loopy superclasses. + Suggested fix: + Add the constraint ‘Foo f’ to the instance context, + even though it seems logically implied by other constraints in the context. ===================================== testsuite/tests/typecheck/should_compile/T22912.hs ===================================== @@ -0,0 +1,26 @@ +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +module T22912 where + + +class c => Exactly c +instance c => Exactly c +class c => Implies c + +data Dict c = c => Dict + +anythingDict :: forall c. Dict c +anythingDict = go + where + go :: (Exactly (Implies c) => Implies c) => Dict c + go = Dict + +-- This is clearly wrong: we shouldn't be able to produce evidence +-- for any constraint whatsoever! However, GHC can be tricked into +-- producing a bottom dictionary. +-- This test checks that it emits an appropriate warning when doing so, +-- to allow users to adapt their code before we plug the hole completely. ===================================== testsuite/tests/typecheck/should_compile/T22912.stderr ===================================== @@ -0,0 +1,12 @@ + +T22912.hs:17:16: warning: [GHC-36038] [-Wloopy-superclass-solve (in -Wdefault)] + I am solving the constraint ‘Implies c’, + arising from the head of a quantified constraint + arising from a use of ‘go’, + in a way that might turn out to loop at runtime. + Future versions of GHC will turn this warning into an error. + See the user manual, § Undecidable instances and loopy superclasses. + Suggested fix: + Add the constraint ‘Implies + c’ to the context of the quantified constraint, + even though it seems logically implied by other constraints in the context. ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -857,3 +857,6 @@ test('T22647', normal, compile, ['']) test('T19577', normal, compile, ['']) test('T22383', normal, compile, ['']) test('T21501', normal, compile, ['']) +test('T20666b', normal, compile, ['']) +test('T22891', normal, compile, ['']) +test('T22912', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T20666.stderr ===================================== @@ -1,20 +1,20 @@ -T20666.hs:13:10: error: [GHC-39999] - • Could not deduce ‘Show (T c)’ - arising from the superclasses of an instance declaration - from the context: (D d, c ~ S d) - bound by the instance declaration at T20666.hs:13:10-31 - Possible fix: - If the constraint looks soluble from a superclass of the instance context, - read 'Undecidable instances and loopy superclasses' in the user manual - • In the instance declaration for ‘C1 c’ +T20666.hs:13:10: warning: [GHC-36038] [-Wloopy-superclass-solve (in -Wdefault)] + I am solving the constraint ‘Show (T c)’, + arising from the superclasses of an instance declaration, + in a way that might turn out to loop at runtime. + Future versions of GHC will turn this warning into an error. + See the user manual, § Undecidable instances and loopy superclasses. + Suggested fix: + Add the constraint ‘Show (T c)’ to the instance context, + even though it seems logically implied by other constraints in the context. -T20666.hs:17:10: error: [GHC-39999] - • Could not deduce ‘Show (T c)’ - arising from the superclasses of an instance declaration - from the context: (D d, c ~ S d, c' ~ c) - bound by the instance declaration at T20666.hs:17:10-40 - Possible fix: - If the constraint looks soluble from a superclass of the instance context, - read 'Undecidable instances and loopy superclasses' in the user manual - • In the instance declaration for ‘C2 c'’ +T20666.hs:17:10: warning: [GHC-36038] [-Wloopy-superclass-solve (in -Wdefault)] + I am solving the constraint ‘Show (T c)’, + arising from the superclasses of an instance declaration, + in a way that might turn out to loop at runtime. + Future versions of GHC will turn this warning into an error. + See the user manual, § Undecidable instances and loopy superclasses. + Suggested fix: + Add the constraint ‘Show (T c)’ to the instance context, + even though it seems logically implied by other constraints in the context. ===================================== testsuite/tests/typecheck/should_fail/T20666a.stderr ===================================== @@ -1,10 +1,10 @@ -T20666a.hs:11:10: error: [GHC-39999] - • Could not deduce ‘Eq (F [a])’ - arising from the superclasses of an instance declaration - from the context: D [a] - bound by the instance declaration at T20666a.hs:11:10-23 - Possible fix: - If the constraint looks soluble from a superclass of the instance context, - read 'Undecidable instances and loopy superclasses' in the user manual - • In the instance declaration for ‘C [a]’ +T20666a.hs:11:10: warning: [GHC-36038] [-Wloopy-superclass-solve (in -Wdefault)] + I am solving the constraint ‘Eq (F [a])’, + arising from the superclasses of an instance declaration, + in a way that might turn out to loop at runtime. + Future versions of GHC will turn this warning into an error. + See the user manual, § Undecidable instances and loopy superclasses. + Suggested fix: + Add the constraint ‘Eq (F [a])’ to the instance context, + even though it seems logically implied by other constraints in the context. ===================================== testsuite/tests/typecheck/should_fail/T6161.stderr ===================================== @@ -1,7 +1,10 @@ -T6161.hs:19:10: error: [GHC-39999] - • Could not deduce ‘Super (Fam a)’ - arising from the superclasses of an instance declaration - from the context: Foo a - bound by the instance declaration at T6161.hs:19:10-31 - • In the instance declaration for ‘Duper (Fam a)’ +T6161.hs:19:10: warning: [GHC-36038] [-Wloopy-superclass-solve (in -Wdefault)] + I am solving the constraint ‘Super (Fam a)’, + arising from the superclasses of an instance declaration, + in a way that might turn out to loop at runtime. + Future versions of GHC will turn this warning into an error. + See the user manual, § Undecidable instances and loopy superclasses. + Suggested fix: + Add the constraint ‘Super (Fam a)’ to the instance context, + even though it seems logically implied by other constraints in the context. ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -241,7 +241,7 @@ test('tcfail215', normal, compile_fail, ['']) test('tcfail216', normal, compile_fail, ['']) test('tcfail217', normal, compile_fail, ['']) test('tcfail218', normal, compile_fail, ['']) -test('tcfail223', normal, compile_fail, ['']) +test('tcfail223', normal, compile, ['']) # To become compile_fail after migration period (see #22912) test('tcfail224', normal, compile_fail, ['']) test('tcfail225', normal, compile_fail, ['']) @@ -294,7 +294,7 @@ test('T19187a', normal, compile_fail, ['']) test('T2534', normal, compile_fail, ['']) test('T7175', normal, compile_fail, ['']) test('T7210', normal, compile_fail, ['']) -test('T6161', normal, compile_fail, ['']) +test('T6161', normal, compile, ['']) # To become compile_fail after migration period (see #22912) test('T7368', normal, compile_fail, ['']) test('T7264', normal, compile_fail, ['']) test('T6069', normal, compile_fail, ['']) @@ -665,5 +665,5 @@ test('T21530a', normal, compile_fail, ['']) test('T21530b', normal, compile_fail, ['']) test('T22570', normal, compile_fail, ['']) test('T22645', normal, compile_fail, ['']) -test('T20666', normal, compile_fail, ['']) -test('T20666a', normal, compile_fail, ['']) +test('T20666', normal, compile, ['']) # To become compile_fail after migration period (see #22912) +test('T20666a', normal, compile, ['']) # To become compile_fail after migration period (see #22912) ===================================== testsuite/tests/typecheck/should_fail/tcfail223.stderr ===================================== @@ -1,9 +1,10 @@ -tcfail223.hs:10:10: error: [GHC-39999] - • Could not deduce ‘Class1 a’ - arising from the superclasses of an instance declaration - from the context: Class3 a - bound by the instance declaration at tcfail223.hs:10:10-29 - Possible fix: - add (Class1 a) to the context of the instance declaration - • In the instance declaration for ‘Class2 a’ +tcfail223.hs:10:10: warning: [GHC-36038] [-Wloopy-superclass-solve (in -Wdefault)] + I am solving the constraint ‘Class1 a’, + arising from the superclasses of an instance declaration, + in a way that might turn out to loop at runtime. + Future versions of GHC will turn this warning into an error. + See the user manual, § Undecidable instances and loopy superclasses. + Suggested fix: + Add the constraint ‘Class1 a’ to the instance context, + even though it seems logically implied by other constraints in the context. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9fb4ca89bff9873e5f6a6849fa22a349c94deaae -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9fb4ca89bff9873e5f6a6849fa22a349c94deaae You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 16:32:56 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 14 Feb 2023 11:32:56 -0500 Subject: [Git][ghc/ghc][master] rts: make it possible to change mblock size on 32-bit targets Message-ID: <63ebb7b884c0d_26da84ea45ee49257ed@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 3 changed files: - rts/sm/GCUtils.c - rts/sm/HeapAlloc.h - rts/sm/NonMoving.h Changes: ===================================== rts/sm/GCUtils.c ===================================== @@ -350,7 +350,12 @@ alloc_todo_block (gen_workspace *ws, uint32_t size) bd = gct->free_blocks; gct->free_blocks = bd->link; } else { - allocBlocks_sync(16, &bd); + // We allocate in chunks of at most 16 blocks, use one + // block to satisfy the allocation request and place + // the rest on `gct->free_blocks` for future use. + StgWord chunk_size = 16; + StgWord n_blocks = stg_min(chunk_size, 1 << (MBLOCK_SHIFT - BLOCK_SHIFT - 1)); + allocBlocks_sync(n_blocks, &bd); gct->free_blocks = bd->link; } } ===================================== rts/sm/HeapAlloc.h ===================================== @@ -63,8 +63,7 @@ extern struct mblock_address_range mblock_address_space; #elif SIZEOF_VOID_P == 4 extern StgWord8 mblock_map[]; -/* On a 32-bit machine a 4KB table is always sufficient */ -# define MBLOCK_MAP_SIZE 4096 +# define MBLOCK_MAP_SIZE (1 << (32 - MBLOCK_SHIFT)) # define MBLOCK_MAP_ENTRY(p) ((StgWord)(p) >> MBLOCK_SHIFT) # define HEAP_ALLOCED(p) mblock_map[MBLOCK_MAP_ENTRY(p)] # define HEAP_ALLOCED_GC(p) HEAP_ALLOCED(p) ===================================== rts/sm/NonMoving.h ===================================== @@ -29,6 +29,8 @@ GHC_STATIC_ASSERT(NONMOVING_SEGMENT_SIZE % BLOCK_SIZE == 0, "non-moving segment size must be multiple of block size"); +GHC_STATIC_ASSERT(NONMOVING_SEGMENT_BLOCKS * 2 <= BLOCKS_PER_MBLOCK, "non-moving segment size must not exceed half of mblock size"); + // The index of a block within a segment typedef uint16_t nonmoving_block_idx; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1928c7f3e9dfc13226e8cf786a565d42df6dad41 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1928c7f3e9dfc13226e8cf786a565d42df6dad41 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 16:33:27 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 14 Feb 2023 11:33:27 -0500 Subject: [Git][ghc/ghc][master] Update outdated references to notes Message-ID: <63ebb7d7735aa_26da84bb0cd4492929a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - 10 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Types/Fixity.hs - compiler/GHC/Types/ForeignCall.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/Language/Haskell/Syntax/Lit.hs Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -800,7 +800,7 @@ type DataConEnv a = UniqFM DataCon a -- Keyed by DataCon -- emit a warning (in checkValidDataCon) and treat it like -- @(HsSrcBang _ NoSrcUnpack SrcLazy)@ data HsSrcBang = - HsSrcBang SourceText -- Note [Pragma source text] in GHC.Types.SourceText + HsSrcBang SourceText -- Note [Pragma source text] in "GHC.Types.SourceText" SrcUnpackedness SrcStrictness deriving Data.Data ===================================== compiler/GHC/Hs/Binds.hs ===================================== @@ -680,7 +680,7 @@ type instance XSpecInstSig (GhcPass p) = (EpAnn [AddEpAnn], SourceText) type instance XMinimalSig (GhcPass p) = (EpAnn [AddEpAnn], SourceText) type instance XSCCFunSig (GhcPass p) = (EpAnn [AddEpAnn], SourceText) type instance XCompleteMatchSig (GhcPass p) = (EpAnn [AddEpAnn], SourceText) - -- SourceText: Note [Pragma source text] in GHC.Types.SourceText + -- SourceText: Note [Pragma source text] in "GHC.Types.SourceText" type instance XXSig GhcPs = DataConCantHappen type instance XXSig GhcRn = IdSig type instance XXSig GhcTc = IdSig ===================================== compiler/GHC/Hs/ImpExp.hs ===================================== @@ -77,7 +77,7 @@ type instance ImportDeclPkgQual GhcTc = PkgQual type instance XCImportDecl GhcPs = XImportDeclPass type instance XCImportDecl GhcRn = XImportDeclPass type instance XCImportDecl GhcTc = DataConCantHappen - -- Note [Pragma source text] in GHC.Types.SourceText + -- Note [Pragma source text] in "GHC.Types.SourceText" data XImportDeclPass = XImportDeclPass { ideclAnn :: EpAnn EpAnnImportDecl ===================================== compiler/GHC/Parser.y ===================================== @@ -3950,7 +3950,7 @@ getPRIMWORDs (L _ (ITprimword src _)) = src getLABELVARIDs (L _ (ITlabelvarid src _)) = src --- See Note [Pragma source text] in "GHC.Types.Basic" for the following +-- See Note [Pragma source text] in "GHC.Types.SourceText" for the following getINLINE_PRAGs (L _ (ITinline_prag _ inl _)) = inlineSpecSource inl getOPAQUE_PRAGs (L _ (ITopaque_prag src)) = src getSPEC_PRAGs (L _ (ITspec_prag src)) = src ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -771,7 +771,7 @@ data Token | ITdependency | ITrequires - -- Pragmas, see Note [Pragma source text] in "GHC.Types.Basic" + -- Pragmas, see Note [Pragma source text] in "GHC.Types.SourceText" | ITinline_prag SourceText InlineSpec RuleMatchInfo | ITopaque_prag SourceText | ITspec_prag SourceText -- SPECIALISE @@ -855,17 +855,17 @@ data Token | ITlabelvarid SourceText FastString -- Overloaded label: #x -- The SourceText is required because we can -- have a string literal as a label - -- Note [Literal source text] in "GHC.Types.Basic" + -- Note [Literal source text] in "GHC.Types.SourceText" - | ITchar SourceText Char -- Note [Literal source text] in "GHC.Types.Basic" - | ITstring SourceText FastString -- Note [Literal source text] in "GHC.Types.Basic" - | ITinteger IntegralLit -- Note [Literal source text] in "GHC.Types.Basic" + | ITchar SourceText Char -- Note [Literal source text] in "GHC.Types.SourceText" + | ITstring SourceText FastString -- Note [Literal source text] in "GHC.Types.SourceText" + | ITinteger IntegralLit -- Note [Literal source text] in "GHC.Types.SourceText" | ITrational FractionalLit - | ITprimchar SourceText Char -- Note [Literal source text] in "GHC.Types.Basic" - | ITprimstring SourceText ByteString -- Note [Literal source text] in "GHC.Types.Basic" - | ITprimint SourceText Integer -- Note [Literal source text] in "GHC.Types.Basic" - | ITprimword SourceText Integer -- Note [Literal source text] in "GHC.Types.Basic" + | ITprimchar SourceText Char -- Note [Literal source text] in "GHC.Types.SourceText" + | ITprimstring SourceText ByteString -- Note [Literal source text] in "GHC.Types.SourceText" + | ITprimint SourceText Integer -- Note [Literal source text] in "GHC.Types.SourceText" + | ITprimword SourceText Integer -- Note [Literal source text] in "GHC.Types.SourceText" | ITprimfloat FractionalLit | ITprimdouble FractionalLit ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -2587,7 +2587,7 @@ mkInlinePragma :: SourceText -> (InlineSpec, RuleMatchInfo) -> Maybe Activation -- The (Maybe Activation) is because the user can omit -- the activation spec (and usually does) mkInlinePragma src (inl, match_info) mb_act - = InlinePragma { inl_src = src -- Note [Pragma source text] in GHC.Types.SourceText + = InlinePragma { inl_src = src -- Note [Pragma source text] in "GHC.Types.SourceText" , inl_inline = inl , inl_sat = Nothing , inl_act = act ===================================== compiler/GHC/Types/Fixity.hs ===================================== @@ -24,7 +24,7 @@ import GHC.Utils.Binary import Data.Data hiding (Fixity, Prefix, Infix) data Fixity = Fixity SourceText Int FixityDirection - -- Note [Pragma source text] + -- Note [Pragma source text] in "GHC.Types.SourceText" deriving Data instance Outputable Fixity where ===================================== compiler/GHC/Types/ForeignCall.hs ===================================== @@ -99,7 +99,7 @@ playInterruptible _ = False data CExportSpec = CExportStatic -- foreign export ccall foo :: ty SourceText -- of the CLabelString. - -- See Note [Pragma source text] in GHC.Types.SourceText + -- See Note [Pragma source text] in "GHC.Types.SourceText" CLabelString -- C Name of exported function CCallConv deriving Data @@ -117,7 +117,7 @@ data CCallTarget -- An "unboxed" ccall# to named function in a particular package. = StaticTarget SourceText -- of the CLabelString. - -- See Note [Pragma source text] in GHC.Types.SourceText + -- See Note [Pragma source text] in "GHC.Types.SourceText" CLabelString -- C-land name of label. (Maybe Unit) -- What package the function is in. @@ -233,7 +233,7 @@ instance Outputable CCallSpec where = text "__ffi_dyn_ccall" <> gc_suf <+> text "\"\"" -- The filename for a C header file --- Note [Pragma source text] in GHC.Types.SourceText +-- Note [Pragma source text] in "GHC.Types.SourceText" data Header = Header SourceText FastString deriving (Eq, Data) @@ -247,7 +247,7 @@ instance Outputable Header where -- 'GHC.Parser.Annotation.AnnClose' @'\#-}'@, -- For details on above see Note [exact print annotations] in "GHC.Parser.Annotation" -data CType = CType SourceText -- Note [Pragma source text] in GHC.Types.SourceText +data CType = CType SourceText -- Note [Pragma source text] in "GHC.Types.SourceText" (Maybe Header) -- header to include for this type (SourceText,FastString) -- the type itself deriving (Eq, Data) ===================================== compiler/Language/Haskell/Syntax/Decls.hs ===================================== @@ -1599,7 +1599,7 @@ data RuleDecl pass { rd_ext :: XHsRule pass -- ^ After renamer, free-vars from the LHS and RHS , rd_name :: XRec pass RuleName - -- ^ Note [Pragma source text] in "GHC.Types.Basic" + -- ^ Note [Pragma source text] in "GHC.Types.SourceText" , rd_act :: Activation , rd_tyvs :: Maybe [LHsTyVarBndr () (NoGhcTc pass)] -- ^ Forall'd type vars ===================================== compiler/Language/Haskell/Syntax/Lit.hs ===================================== @@ -42,9 +42,9 @@ import Prelude (Integer) ************************************************************************ -} --- Note [Literal source text] in GHC.Types.Basic for SourceText fields in +-- Note [Literal source text] in "GHC.Types.SourceText" for SourceText fields in -- the following --- Note [Trees That Grow] in Language.Haskell.Syntax.Extension for the Xxxxx +-- Note [Trees That Grow] in "Language.Haskell.Syntax.Extension" for the Xxxxx -- fields in the following -- | Haskell Literal data HsLit x @@ -107,7 +107,7 @@ data HsOverLit p | XOverLit !(XXOverLit p) --- Note [Literal source text] in GHC.Types.Basic for SourceText fields in +-- Note [Literal source text] in "GHC.Types.SourceText" for SourceText fields in -- the following -- | Overloaded Literal Value data OverLitVal View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/78aa3b39133feb165b6e305af1b84620a450c8ef -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/78aa3b39133feb165b6e305af1b84620a450c8ef You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 16:34:09 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 14 Feb 2023 11:34:09 -0500 Subject: [Git][ghc/ghc][master] Documentation: Improve Foldable1 documentation Message-ID: <63ebb801dc88e_26da84c2ec974934419@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 1 changed file: - libraries/base/Data/Foldable1.hs Changes: ===================================== libraries/base/Data/Foldable1.hs ===================================== @@ -82,20 +82,27 @@ class Foldable t => Foldable1 t where -- foldMap f = foldMap f . toNonEmpty -- foldrMap1 f g = foldrMap1 f g . toNonEmpty - -- | Combine the elements of a structure using a semigroup. + -- | Given a structure with elements whose type is a 'Semigroup', combine + -- them via the semigroup's @('<>')@ operator. This fold is + -- right-associative and lazy in the accumulator. When you need a strict + -- left-associative fold, use 'foldMap1'' instead, with 'id' as the map. fold1 :: Semigroup m => t m -> m fold1 = foldMap1 id - -- | Map each element of the structure to a semigroup, - -- and combine the results. + -- | Map each element of the structure to a semigroup, and combine the + -- results with @('<>')@. This fold is right-associative and lazy in the + -- accumulator. For strict left-associative folds consider 'foldMap1'' + -- instead. -- - -- >>> foldMap1 Sum (1 :| [2, 3, 4]) - -- Sum {getSum = 10} + -- >>> foldMap1 (:[]) (1 :| [2, 3, 4]) + -- [1,2,3,4] -- foldMap1 :: Semigroup m => (a -> m) -> t a -> m foldMap1 f = foldrMap1 f (\a m -> f a <> m) - -- | A variant of 'foldMap1' that is strict in the accumulator. + -- | A left-associative variant of 'foldMap1' that is strict in the + -- accumulator. Use this for strict reduction when partial results are + -- merged via @('<>')@. -- -- >>> foldMap1' Sum (1 :| [2, 3, 4]) -- Sum {getSum = 10} @@ -103,7 +110,7 @@ class Foldable t => Foldable1 t where foldMap1' :: Semigroup m => (a -> m) -> t a -> m foldMap1' f = foldlMap1' f (\m a -> m <> f a) - -- | List of elements of a structure, from left to right. + -- | 'NonEmpty' list of elements of a structure, from left to right. -- -- >>> toNonEmpty (Identity 2) -- 2 :| [] @@ -143,7 +150,24 @@ class Foldable t => Foldable1 t where last :: t a -> a last = getLast #. foldMap1 Last - -- | Generalized 'foldr1'. + -- | Right-associative fold of a structure, lazy in the accumulator. + -- + -- In case of 'NonEmpty' lists, 'foldrMap1', when given a function @f@, a + -- binary operator @g@, and a list, reduces the list using @g@ from right to + -- left applying @f@ to the rightmost element: + -- + -- > foldrMap1 f g (x1 :| [x2, ..., xn1, xn]) == x1 `g` (x2 `g` ... (xn1 `g` (f xn))...) + -- + -- Note that since the head of the resulting expression is produced by + -- an application of @g@ to the first element of the list, if @g@ is lazy + -- in its right argument, 'foldrMap1' can produce a terminating expression + -- from an unbounded list. + -- + -- For a general 'Foldable1' structure this should be semantically identical + -- to: + -- + -- @foldrMap1 f g = foldrMap1 f g . 'toNonEmpty'@ + -- foldrMap1 :: (a -> b) -> (a -> b -> b) -> t a -> b foldrMap1 f g xs = appFromMaybe (foldMap1 (FromMaybe #. h) xs) Nothing @@ -151,7 +175,19 @@ class Foldable t => Foldable1 t where h a Nothing = f a h a (Just b) = g a b - -- | Generalized 'foldl1''. + -- | Left-associative fold of a structure but with strict application of the + -- operator. + -- + -- This ensures that each step of the fold is forced to Weak Head Normal + -- Form before being applied, avoiding the collection of thunks that would + -- otherwise occur. This is often what you want to strictly reduce a + -- finite structure to a single strict result. + -- + -- For a general 'Foldable1' structure this should be semantically identical + -- to: + -- + -- @foldlMap1' f z = foldlMap1' f z . 'toNonEmpty'@ + -- foldlMap1' :: (a -> b) -> (b -> a -> b) -> t a -> b foldlMap1' f g xs = foldrMap1 f' g' xs SNothing @@ -164,7 +200,33 @@ class Foldable t => Foldable1 t where g' a x SNothing = x $! SJust (f a) g' a x (SJust b) = x $! SJust (g b a) - -- | Generalized 'foldl1'. + -- | Left-associative fold of a structure, lazy in the accumulator. This is + -- rarely what you want, but can work well for structures with efficient + -- right-to-left sequencing and an operator that is lazy in its left + -- argument. + -- + -- In case of 'NonEmpty' lists, 'foldlMap1', when given a function @f@, a + -- binary operator @g@, and a list, reduces the list using @g@ from left to + -- right applying @f@ to the leftmost element: + -- + -- > foldlMap1 f g (x1 :| [x2, ..., xn]) == (...(((f x1) `g` x2) `g`...) `g` xn + -- + -- Note that to produce the outermost application of the operator the entire + -- input list must be traversed. This means that 'foldlMap1' will diverge if + -- given an infinite list. + -- + -- If you want an efficient strict left-fold, you probably want to use + -- 'foldlMap1'' instead of 'foldlMap1'. The reason for this is that the + -- latter does not force the /inner/ results (e.g. @(f x1) \`g\` x2@ in the + -- above example) before applying them to the operator (e.g. to + -- @(\`g\` x3)@). This results in a thunk chain \(O(n)\) elements long, + -- which then must be evaluated from the outside-in. + -- + -- For a general 'Foldable1' structure this should be semantically identical + -- to: + -- + -- @foldlMap1 f g = foldlMap1 f g . 'toNonEmpty'@ + -- foldlMap1 :: (a -> b) -> (b -> a -> b) -> t a -> b foldlMap1 f g xs = appFromMaybe (getDual (foldMap1 ((Dual . FromMaybe) #. h) xs)) Nothing @@ -172,7 +234,21 @@ class Foldable t => Foldable1 t where h a Nothing = f a h a (Just b) = g b a - -- | Generalized 'foldr1''. + -- | 'foldrMap1'' is a variant of 'foldrMap1' that performs strict reduction + -- from right to left, i.e. starting with the right-most element. The input + -- structure /must/ be finite, otherwise 'foldrMap1'' runs out of space + -- (/diverges/). + -- + -- If you want a strict right fold in constant space, you need a structure + -- that supports faster than \(O(n)\) access to the right-most element. + -- + -- This method does not run in constant space for structures such as + -- 'NonEmpty' lists that don't support efficient right-to-left iteration and + -- so require \(O(n)\) space to perform right-to-left reduction. Use of this + -- method with such a structure is a hint that the chosen structure may be a + -- poor fit for the task at hand. If the order in which the elements are + -- combined is not important, use 'foldlMap1'' instead. + -- foldrMap1' :: (a -> b) -> (a -> b -> b) -> t a -> b foldrMap1' f g xs = foldlMap1 f' g' xs SNothing @@ -187,75 +263,22 @@ class Foldable t => Foldable1 t where -- Combinators ------------------------------------------------------------------------------- --- | Right-associative fold of a structure. --- --- In the case of lists, 'foldr1', when applied to a binary operator, --- and a list, reduces the list using the binary operator, --- from right to left: --- --- > foldr1 f [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn1 `f` xn )...) --- --- Note that, since the head of the resulting expression is produced by --- an application of the operator to the first element of the list, --- 'foldr1' can produce a terminating expression from an infinite list. --- --- For a general 'Foldable1' structure this should be semantically identical --- to, --- --- @foldr1 f = foldr1 f . 'toNonEmpty'@ --- +-- | A variant of 'foldrMap1' where the rightmost element maps to itself. foldr1 :: Foldable1 t => (a -> a -> a) -> t a -> a foldr1 = foldrMap1 id {-# INLINE foldr1 #-} --- | Right-associative fold of a structure, but with strict application of --- the operator. --- +-- | A variant of 'foldrMap1'' where the rightmost element maps to itself. foldr1' :: Foldable1 t => (a -> a -> a) -> t a -> a foldr1' = foldrMap1' id {-# INLINE foldr1' #-} --- | Left-associative fold of a structure. --- --- In the case of lists, 'foldl1', when applied to a binary --- operator, and a list, reduces the list using the binary operator, --- from left to right: --- --- > foldl1 f [x1, x2, ..., xn] == (...((x1 `f` x2) `f`...) `f` xn --- --- Note that to produce the outermost application of the operator the --- entire input list must be traversed. This means that 'foldl1' will --- diverge if given an infinite list. --- --- Also note that if you want an efficient left-fold, you probably want to --- use 'foldl1'' instead of 'foldl1'. The reason for this is that latter does --- not force the "inner" results (e.g. @x1 \`f\` x2@ in the above example) --- before applying them to the operator (e.g. to @(\`f\` x3)@). This results --- in a thunk chain \(\mathcal{O}(n)\) elements long, which then must be --- evaluated from the outside-in. --- --- For a general 'Foldable1' structure this should be semantically identical --- to, --- --- @foldl1 f z = foldl1 f . 'toNonEmpty'@ --- +-- | A variant of 'foldlMap1' where the leftmost element maps to itself. foldl1 :: Foldable1 t => (a -> a -> a) -> t a -> a foldl1 = foldlMap1 id {-# INLINE foldl1 #-} --- | Left-associative fold of a structure but with strict application of --- the operator. --- --- This ensures that each step of the fold is forced to weak head normal --- form before being applied, avoiding the collection of thunks that would --- otherwise occur. This is often what you want to strictly reduce a finite --- list to a single, monolithic result (e.g. 'length'). --- --- For a general 'Foldable1' structure this should be semantically identical --- to, --- --- @foldl1' f z = foldl1 f . 'toNonEmpty'@ --- +-- | A variant of 'foldlMap1'' where the leftmost element maps to itself. foldl1' :: Foldable1 t => (a -> a -> a) -> t a -> a foldl1' = foldlMap1' id {-# INLINE foldl1' #-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e8baecd20cbd764a081c6195959719d4c73e65a8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e8baecd20cbd764a081c6195959719d4c73e65a8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 16:34:50 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 14 Feb 2023 11:34:50 -0500 Subject: [Git][ghc/ghc][master] fix: Mark ghci Prelude import as implicit Message-ID: <63ebb82af8a0_26da84d3664d0939650@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 4 changed files: - ghc/GHCi/UI.hs - testsuite/tests/ghci/scripts/ghci038.stdout - + testsuite/tests/ghci/should_run/T22829.hs - testsuite/tests/ghci/should_run/all.T Changes: ===================================== ghc/GHCi/UI.hs ===================================== @@ -556,7 +556,10 @@ interactiveUI config srcs maybe_exprs = do default_editor <- liftIO $ findEditor eval_wrapper <- mkEvalWrapper default_progname default_args - let prelude_import = simpleImportDecl preludeModuleName + let prelude_import = + case simpleImportDecl preludeModuleName of + -- Set to True because Prelude is implicitly imported. + impDecl at ImportDecl{ideclExt=ext} -> impDecl{ideclExt = ext{ideclImplicit=True}} hsc_env <- GHC.getSession let in_multi = length (hsc_all_home_unit_ids hsc_env) > 1 empty_cache <- liftIO newIfaceCache ===================================== testsuite/tests/ghci/scripts/ghci038.stdout ===================================== @@ -1,20 +1,20 @@ -import Prelude -- implicit +import (implicit) Prelude -- implicit import Prelude == map in scope due to explicit 'import Prelude' map :: (a -> b) -> [a] -> [b] import Prelude == still in scope, 'import Prelude ()' is subsumed by 'import Prelude' map :: (a -> b) -> [a] -> [b] -import Prelude -- implicit +import (implicit) Prelude -- implicit == still in scope, implicit import of Prelude map :: (a -> b) -> [a] -> [b] import Prelude () == not in scope now -import Prelude -- implicit +import (implicit) Prelude -- implicit x :: (a -> b) -> [a] -> [b] :module +*Foo -- added automatically :m -Foo -import Prelude -- implicit +import (implicit) Prelude -- implicit :m +*Foo :module +*Foo x :: (a -> b) -> [a] -> [b] ===================================== testsuite/tests/ghci/should_run/T22829.hs ===================================== @@ -0,0 +1,2 @@ +-- Do nothing, we simply want to load Prelude in ghci with -Wmissing-import-lists and -Werror +main = pure () ===================================== testsuite/tests/ghci/should_run/all.T ===================================== @@ -87,3 +87,4 @@ test('T21300', just_ghci, ghci_script, ['T21300.script']) test('UnliftedDataType2', just_ghci, compile_and_run, ['']) test('SizedLiterals', [req_interp, extra_files(["SizedLiteralsA.hs"]),extra_hc_opts("-O -fbyte-code-and-object-code -fprefer-byte-code")], compile_and_run, ['']) +test('T22829', just_ghci + [extra_hc_opts("-Wmissing-import-lists -Werror")], compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/85a1a575f9909bbfa84268a9744f22ca0f0a1593 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/85a1a575f9909bbfa84268a9744f22ca0f0a1593 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 16:35:29 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 14 Feb 2023 11:35:29 -0500 Subject: [Git][ghc/ghc][master] compiler: fix generateCgIPEStub for no-tables-next-to-code builds Message-ID: <63ebb851774e5_26da8449bc6a894789@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 1 changed file: - compiler/GHC/Driver/GenerateCgIPEStub.hs Changes: ===================================== compiler/GHC/Driver/GenerateCgIPEStub.hs ===================================== @@ -23,7 +23,7 @@ import GHC.Driver.Config.StgToCmm import GHC.Driver.Config.Cmm import GHC.Prelude import GHC.Runtime.Heap.Layout (isStackRep) -import GHC.Settings (Platform, platformUnregisterised) +import GHC.Settings (Platform, platformTablesNextToCode) import GHC.StgToCmm.Monad (getCmm, initC, runC, initFCodeState) import GHC.StgToCmm.Prof (initInfoTableProv) import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos) @@ -52,13 +52,13 @@ by `generateCgIPEStub`. This leads to the question: How to figure out the source location of a return frame? -While the lookup algorithms for registerised and unregisterised builds differ in details, they have in +While the lookup algorithms when tables-next-to-code is on/off differ in details, they have in common that we want to lookup the `CmmNode.CmmTick` (containing a `SourceNote`) that is nearest (before) the usage of the return frame's label. (Which label and label type is used differs between these two use cases.) -Registerised -~~~~~~~~~~~~~ +With tables-next-to-code +~~~~~~~~~~~~~~~~~~~~~~~~ Let's consider this example: ``` @@ -117,10 +117,10 @@ sure as there are e.g. update frames, too) with it's label (`c18g` in the exampl `IpeSourceLocation`. (There are other `Tickish` constructors like `ProfNote` or `HpcTick`, these are ignored.) -Unregisterised -~~~~~~~~~~~~~ +Without tables-next-to-code +~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In unregisterised builds there is no return frame / continuation label in calls. The continuation (i.e. return +When tables-next-to-code is off, there is no return frame / continuation label in calls. The continuation (i.e. return frame) is set in an explicit Cmm assignment. Thus the tick lookup algorithm has to be slightly different. ``` @@ -223,9 +223,9 @@ generateCgIPEStub hsc_env this_mod denv s = do if (isStackRep . cit_rep) infoTable then do let findFun = - if platformUnregisterised platform - then findCmmTickishForForUnregistered (cit_lbl infoTable) - else findCmmTickishForRegistered infoTableLabel + if platformTablesNextToCode platform + then findCmmTickishWithTNTC infoTableLabel + else findCmmTickishSansTNTC (cit_lbl infoTable) blocks = concatMap toBlockList (graphs cmmGroup) firstJusts $ map findFun blocks else Nothing @@ -236,8 +236,8 @@ generateCgIPEStub hsc_env this_mod denv s = do go acc (CmmProc _ _ _ g) = g : acc go acc _ = acc - findCmmTickishForRegistered :: Label -> Block CmmNode C C -> Maybe IpeSourceLocation - findCmmTickishForRegistered label block = do + findCmmTickishWithTNTC :: Label -> Block CmmNode C C -> Maybe IpeSourceLocation + findCmmTickishWithTNTC label block = do let (_, middleBlock, endBlock) = blockSplit block isCallWithReturnFrameLabel endBlock label @@ -255,8 +255,8 @@ generateCgIPEStub hsc_env this_mod denv s = do maybeTick (CmmTick (SourceNote span name)) = Just (span, name) maybeTick _ = Nothing - findCmmTickishForForUnregistered :: CLabel -> Block CmmNode C C -> Maybe IpeSourceLocation - findCmmTickishForForUnregistered cLabel block = do + findCmmTickishSansTNTC :: CLabel -> Block CmmNode C C -> Maybe IpeSourceLocation + findCmmTickishSansTNTC cLabel block = do let (_, middleBlock, _) = blockSplit block find cLabel (blockToList middleBlock) Nothing where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3b019a7ac8fc9059cc3213f6f95a2daef97ca442 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3b019a7ac8fc9059cc3213f6f95a2daef97ca442 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 16:44:08 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 14 Feb 2023 11:44:08 -0500 Subject: [Git][ghc/ghc][wip/unboxed-codebuffer] Fix build Message-ID: <63ebba58a68d8_26da8449bc6d09590ea@gitlab.mail> Josh Meredith pushed to branch wip/unboxed-codebuffer at Glasgow Haskell Compiler / GHC Commits: ed5674b4 by Josh Meredith at 2023-02-14T16:43:39+00:00 Fix build - - - - - 1 changed file: - libraries/base/GHC/IO/Encoding/Iconv.hs Changes: ===================================== libraries/base/GHC/IO/Encoding/Iconv.hs ===================================== @@ -136,7 +136,7 @@ newIConv from to rec fn = iconvt <- throwErrnoIfMinus1 "mkTextEncoding" $ hs_iconv_open to_str from_str let iclose = throwErrnoIfMinus1_ "Iconv.close" $ hs_iconv_close iconvt fn_iconvt ibuf obuf st = case unIO (fn iconvt ibuf obuf) st of - (# st', (prog, ibuf', obuf') #) -> (# st', prog, ibuf', obuf' #) + (# st', (prog, ibuf', obuf') #) -> (# st', prog, ibuf', obuf' #) return BufferCodec{ encode# = fn_iconvt, recover# = rec#, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ed5674b42dce35ed410b4cfef66b5df25f95cc07 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ed5674b42dce35ed410b4cfef66b5df25f95cc07 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 17:06:16 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 14 Feb 2023 12:06:16 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add clangd flag to include generated header files Message-ID: <63ebbf887bacc_26da84c2ec9749705aa@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 75905868 by doyougnu at 2023-02-14T12:06:03-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 7e030d41 by Bryan Richter at 2023-02-14T12:06:04-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 116cf74c by Cheng Shao at 2023-02-14T12:06:06-05:00 rts: add the rts_clearMemory function This patch adds the rts_clearMemory function that does its best to zero out unused RTS memory for a wasm backend use case. See the comment above rts_clearMemory() prototype declaration for more detailed explanation. Closes #22920. - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compile_flags.txt - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Driver/Config/Stg/Pipeline.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Types.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Origin.hs-boot - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Fixity.hs - compiler/GHC/Types/ForeignCall.hs - compiler/GHC/Types/Hint.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/79e42dbf194453526f80ff204d3ebdde7e25d934...116cf74cea95f04d10fb98235596d4735a87d876 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/79e42dbf194453526f80ff204d3ebdde7e25d934...116cf74cea95f04d10fb98235596d4735a87d876 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 17:08:09 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 14 Feb 2023 12:08:09 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T22982 Message-ID: <63ebbff969ceb_26da841f6de560976990@gitlab.mail> Ben Gamari pushed new branch wip/T22982 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22982 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 19:48:06 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Tue, 14 Feb 2023 14:48:06 -0500 Subject: [Git][ghc/ghc][wip/T21909] 19 commits: Refresh profiling docs Message-ID: <63ebe5764201d_26da84c2ec97410103bf@gitlab.mail> Apoorv Ingle pushed to branch wip/T21909 at Glasgow Haskell Compiler / GHC Commits: 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 7bd4e095 by Apoorv Ingle at 2023-02-14T13:47:42-06:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Fixes #21909 Added Tests T21909, T21909b Added Note [SimplifyInfer and UndecidableSuperClasses] - - - - - 55c2a5ea by Apoorv Ingle at 2023-02-14T13:47:46-06:00 make expansion fuel a dynamic flag - - - - - 30 changed files: - .gitlab/rel_eng/upload_ghc_libs.py - compile_flags.txt - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Driver/Config/Stg/Pipeline.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Settings/Constants.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Types.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Types/Origin.hs-boot - compiler/GHC/Types/Error/Codes.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8b30116d32dc64e5cf88f20129994975ea028b8a...55c2a5ea7508bd703bdc256f1bc16d5f0feb3211 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8b30116d32dc64e5cf88f20129994975ea028b8a...55c2a5ea7508bd703bdc256f1bc16d5f0feb3211 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 20:04:21 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Tue, 14 Feb 2023 15:04:21 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/andreask/cpr-dependent Message-ID: <63ebe94523b9c_26da846201d58101247a@gitlab.mail> Andreas Klebinger pushed new branch wip/andreask/cpr-dependent at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/cpr-dependent You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 20:05:34 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 14 Feb 2023 15:05:34 -0500 Subject: [Git][ghc/ghc][wip/T22686] gitlab: Collect metadata about binary distributions Message-ID: <63ebe98ebe0f6_26da84c2ec974101263d@gitlab.mail> Ben Gamari pushed to branch wip/T22686 at Glasgow Haskell Compiler / GHC Commits: f6426b6f by Ben Gamari at 2023-02-14T15:05:25-05:00 gitlab: Collect metadata about binary distributions Fixes #22686. - - - - - 4 changed files: - + .gitlab/bindist_metadata.py - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/bindist_metadata.py ===================================== @@ -0,0 +1,155 @@ +#!/usr/bin/env python3 + +import sys +import os +import shutil +import re +import ast +from pathlib import Path +import subprocess +import json +from typing import Dict, List, Set, Optional, NamedTuple + +def run(args: List[str]) -> str: + return subprocess.check_output(args, encoding='UTF-8') + +def parse_hadrian_cfg(cfg: str) -> Dict[str,str]: + res = {} + for l in cfg.split('\n'): + if l.startswith('#'): + continue + elif '=' in l: + i = l.find('=') + k = l[:i].strip() + v = l[i+1:].strip() + res[k] = v + + return res + +def get_ghc_info(ghc: Path) -> Dict[str,str]: + import ast + out = run([ghc, '--info']) + pairs = ast.literal_eval(out.strip()) + res = {} + for k,v in pairs: + if v == 'YES': + v = True + elif v == 'NO': + v = False + res[k] = v + + return res + +def get_dynamic_deps(objfile: Path) -> Set[Path]: + out = run(['ldd', objfile]) + return { Path(m.group(1)) for m in re.finditer('=> *([^ ]+)', out) } + +def get_configure_cmdline() -> str: + r = Path('config.log').read_text() + m = re.search(r' $ .+', r) + return m + +class Package(NamedTuple): + name: str + version: str + +def find_providing_package(f: Path) -> Optional[Package]: + if shutil.which('dpkg'): + out = run(['dpkg-query', '--search', f]).strip() + pkg,_file = out.split(':') + + out = run(['dpkg-query', '--show', pkg]).strip() + _pkg,version = out.split() + return Package(pkg, version) + elif shutil.which('rpm'): + out = run(['rpm', '-qf', f, '--queryformat=%{NAME} %{VERSION}\n']).strip() + pkg,version = out.split() + return Package(pkg, version) + elif shutil.which('apk'): + out = run(['apk', 'info', '--who-owns', f]).strip() + pkg = re.find('is owned by ([.+])', out) + + # Determining the version of an installed package is far too difficult; + # some day perhaps upstream will address + # https://gitlab.alpinelinux.org/alpine/apk-tools/-/issues/10704 + db = Path('/lib/apk/db/installed').read_text() + m = re.find(f'P:{pkg}\nV:([.+])\n', db) + version = m.group(1) + return Package(pkg, version) + else: + return None + +def main() -> None: + ghc = Path('_build/stage1/bin/ghc') + ghc_pkg = Path('_build/stage1/bin/ghc-pkg') + + metadata = {} + + system_config = Path('.') / 'hadrian' / 'cfg' / 'system.config' + cfg = parse_hadrian_cfg(system_config.read_text()) + + ###### + # GHC build configuration + ###### + metadata['ghc_version'] = cfg['project-version'] + metadata['git_commit_id'] = cfg['project-git-commit-id'] + metadata['tables_next_to_code'] = cfg['tables-next-to-code'] + metadata['unregisterised'] = cfg['ghc-unregisterised'] + metadata['build_triple'] = cfg['build-platform'] + metadata['host_triple'] = cfg['host-platform'] + metadata['target_triple'] = cfg['target-platform'] + metadata['build_flavour'] = os.environ.get('BUILD_FLAVOUR') + metadata['configure_cmdline'] = get_configure_cmdline() + + opsys = cfg['build-os'] + + ###### + # Information about the bootstrapping environment + ###### + lsb_release = None + if opsys == 'linux': + lsb_release = run(['lsb_release']) + + metadata['bootstrap_environment'] = { + 'ghc': run([cfg['system-ghc'], '--version']).split('\n')[0], + 'cc': run([cfg['system-cc'], '--version']).split('\n')[0], + 'lsb_release': lsb_release, + } + + ###### + # Information about the bootstrapping environment's packages + ###### + metadata['dynamic_deps'] = None + if opsys != 'darwin': + dyn_deps = get_dynamic_deps(ghc) + print(dyn_deps) + deps = { + dep.name: find_providing_package(dep) + for dep in dyn_deps + if not dep.is_relative_to(Path('.').resolve()) + } + metadata['dynamic_deps'] = deps + + ###### + # The contents of the compiler's global package database + ###### + def call_ghc_pkg(args: List[str]) -> str: + return run([ghc_pkg, '--simple-output'] + args).strip() + + metadata['global_packages'] = { + pkg: { + 'version': call_ghc_pkg(['field', pkg, 'version']), + 'extra-libraries': call_ghc_pkg(['field', pkg, 'extra-libraries']).split(), + } + for pkg in call_ghc_pkg(['list', '--names-only']).split() + } + + ###### + # Information about the resulting compiler + ###### + metadata['inplace_ghc_info'] = get_ghc_info(ghc) + + json.dump(metadata, sys.stdout, indent=2) + +if __name__ == '__main__': + main() ===================================== .gitlab/ci.sh ===================================== @@ -478,6 +478,7 @@ function check_msys2_deps() { # Ensure that GHC on Windows doesn't have any dynamic dependencies on msys2 case "$(uname)" in MSYS_*|MINGW*) + info "Checking for unwanted msys2 dependencies..." sysroot="$(cygpath "$SYSTEMROOT")" PATH="$sysroot/System32:$sysroot;$sysroot/Wbem" $@ \ || fail "'$@' failed; there may be unwanted dynamic dependencies." @@ -584,6 +585,9 @@ function test_hadrian() { check_msys2_deps _build/stage1/bin/ghc --version check_release_build + info "Collecting binary distribution metadata..." + run "$TOP/.gitlab/bindist_metadata.py" > metadata.json + # Ensure that statically-linked builds are actually static if [[ "${BUILD_FLAVOUR}" = *static* ]]; then bad_execs="" ===================================== .gitlab/gen_ci.hs ===================================== @@ -680,6 +680,7 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } { junitReport = "junit.xml" , expireIn = "2 weeks" , artifactPaths = [binDistName arch opsys buildConfig ++ ".tar.xz" + ,"metadata.json" ,"junit.xml"] , artifactsWhen = ArtifactsAlways } ===================================== .gitlab/jobs.yaml ===================================== @@ -11,6 +11,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -73,6 +74,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -131,6 +133,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -189,6 +192,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -252,6 +256,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -311,6 +316,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate+llvm.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -370,6 +376,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -429,6 +436,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -494,6 +502,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -555,6 +564,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-cross_wasm32-wasi-release+fully_static.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -616,6 +626,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -677,6 +688,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -740,6 +752,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -801,6 +814,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -864,6 +878,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-centos7-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -924,6 +939,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -983,6 +999,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1042,6 +1059,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1102,6 +1120,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1161,6 +1180,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1220,6 +1240,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1279,6 +1300,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1338,6 +1360,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1399,6 +1422,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1460,6 +1484,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1522,6 +1547,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1581,6 +1607,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb9-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1640,6 +1667,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1701,6 +1729,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1763,6 +1792,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-validate+debug_info.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1824,6 +1854,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-rocky8-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1884,6 +1915,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu18_04-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -1943,6 +1975,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu20_04-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2001,6 +2034,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-int_native-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2060,6 +2094,7 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2120,6 +2155,7 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-darwin-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2184,6 +2220,7 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-linux-deb10-release+no_split_sections.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2244,6 +2281,7 @@ "expire_in": "1 year", "paths": [ "ghc-i386-linux-deb9-release+no_split_sections.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2304,6 +2342,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-darwin-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2370,6 +2409,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2434,6 +2474,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2498,6 +2539,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-centos7-release+no_split_sections.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2559,6 +2601,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2619,6 +2662,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release+debug_info.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2679,6 +2723,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2739,6 +2784,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb9-release+no_split_sections.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2799,6 +2845,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2861,6 +2908,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release+debug_info.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2923,6 +2971,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -2986,6 +3035,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-rocky8-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3047,6 +3097,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu18_04-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3107,6 +3158,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu20_04-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3166,6 +3218,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-int_native-release+no_split_sections.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3226,6 +3279,7 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-release+no_split_sections.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3287,6 +3341,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3351,6 +3406,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3411,6 +3467,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-cross_wasm32-wasi-release+fully_static.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3471,6 +3528,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3533,6 +3591,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3591,6 +3650,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3650,6 +3710,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3709,6 +3770,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3767,6 +3829,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3825,6 +3888,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3883,6 +3947,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -3944,6 +4009,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -4004,6 +4070,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -4065,6 +4132,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", + "metadata.json", "junit.xml" ], "reports": { @@ -4124,6 +4192,7 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", + "metadata.json", "junit.xml" ], "reports": { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f6426b6f33926fada1a82a50b89d736f390f7666 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f6426b6f33926fada1a82a50b89d736f390f7666 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 21:00:51 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 14 Feb 2023 16:00:51 -0500 Subject: [Git][ghc/ghc][wip/T22924] 15 commits: Add clangd flag to include generated header files Message-ID: <63ebf683174ed_26da846201d58102924d@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22924 at Glasgow Haskell Compiler / GHC Commits: 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - a3e75ce7 by Simon Peyton Jones at 2023-02-14T22:00:41+01:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 30 changed files: - .gitlab/rel_eng/upload_ghc_libs.py - compile_flags.txt - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Driver/Config/Stg/Pipeline.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Types.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Origin.hs-boot - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Fixity.hs - compiler/GHC/Types/ForeignCall.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2b0d4d28537988cc304ffb5c292455c8492c793e...a3e75ce74302052540f65d1b326e07e175089812 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2b0d4d28537988cc304ffb5c292455c8492c793e...a3e75ce74302052540f65d1b326e07e175089812 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 21:28:24 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Tue, 14 Feb 2023 16:28:24 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/az/backport-ghc-9.6-T22919 Message-ID: <63ebfcf8a947e_26da84d3664d01033615@gitlab.mail> Alan Zimmerman pushed new branch wip/az/backport-ghc-9.6-T22919 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/az/backport-ghc-9.6-T22919 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 22:55:15 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 14 Feb 2023 17:55:15 -0500 Subject: [Git][ghc/ghc][wip/T22982] Update Makefile Message-ID: <63ec1153b634d_26da841f6de5601052326@gitlab.mail> Ben Gamari pushed to branch wip/T22982 at Glasgow Haskell Compiler / GHC Commits: 36c2d781 by Ben Gamari at 2023-02-14T22:55:14+00:00 Update Makefile - - - - - 1 changed file: - hadrian/bindist/Makefile Changes: ===================================== hadrian/bindist/Makefile ===================================== @@ -77,7 +77,7 @@ endif WrapperBinsDir=${bindir} # N.B. this is duplicated from includes/ghc.mk. -lib/settings : mk/config.mk +lib/settings : config.mk $(call removeFiles,$@) @echo '[("GCC extra via C opts", "$(GccExtraViaCOpts)")' >> $@ @echo ',("C compiler command", "$(SettingsCCompilerCommand)")' >> $@ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/36c2d781294e40988c358a6f31762245484aa279 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/36c2d781294e40988c358a6f31762245484aa279 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Feb 14 23:13:48 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 14 Feb 2023 18:13:48 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T22129-9.2 Message-ID: <63ec15ac3c44f_26da84369a94410589b5@gitlab.mail> Ben Gamari pushed new branch wip/T22129-9.2 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22129-9.2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 15 02:52:02 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 14 Feb 2023 21:52:02 -0500 Subject: [Git][ghc/ghc][wip/T22834] 3 commits: nativeGen: Explicitly set flags of text sections on Windows Message-ID: <63ec48d2125ed_26da84bb0cd4410700d6@gitlab.mail> Ben Gamari pushed to branch wip/T22834 at Glasgow Haskell Compiler / GHC Commits: df3edc69 by Ben Gamari at 2023-02-08T11:57:44-05:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - 3d16a52e by Ben Gamari at 2023-02-08T11:59:40-05:00 nativeGen: Set explicit section types on all platforms - - - - - 24f97b1f by GHC GitLab CI at 2023-02-14T21:15:18-05:00 linker/PEi386: Don't sign-extend symbol section number - - - - - 6 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/CmmToAsm/Ppr.hs - rts/linker/PEi386.c - rts/linker/PEi386.h Changes: ===================================== .gitlab-ci.yml ===================================== @@ -502,7 +502,7 @@ doc-tarball: optional: true - job: nightly-x86_64-windows-validate optional: true - - job: release-x86_64-windows-release+no_split_sections + - job: release-x86_64-windows-release optional: true tags: @@ -526,7 +526,7 @@ doc-tarball: || mv "ghc-x86_64-linux-deb10-release.tar.xz" "$LINUX_BINDIST" \ || true mv "ghc-x86_64-windows-validate.tar.xz" "$WINDOWS_BINDIST" \ - || mv "ghc-x86_64-windows-release+no_split_sections.tar.xz" "$WINDOWS_BINDIST" \ + || mv "ghc-x86_64-windows-release.tar.xz" "$WINDOWS_BINDIST" \ || true if [ ! -f "$LINUX_BINDIST" ]; then echo "Error: $LINUX_BINDIST does not exist. Did the Debian 9 job fail?" ===================================== .gitlab/gen_ci.hs ===================================== @@ -871,8 +871,8 @@ job_groups = -- This job is only for generating head.hackage docs , hackage_doc_job (disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig)) , disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) dwarf) - , fastCI (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken vanilla)) - , disableValidate (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken nativeInt)) + , fastCI (standardBuildsWithConfig Amd64 Windows vanilla) + , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt) , standardBuilds Amd64 Darwin , allowFailureGroup (addValidateRule FreeBSDLabel (validateBuilds Amd64 FreeBSD13 vanilla)) , standardBuilds AArch64 Darwin ===================================== .gitlab/jobs.yaml ===================================== @@ -3156,7 +3156,7 @@ "XZ_OPT": "-9" } }, - "release-x86_64-windows-int_native-release+no_split_sections": { + "release-x86_64-windows-int_native-release": { "after_script": [ "bash .gitlab/ci.sh save_cache", "bash .gitlab/ci.sh clean" @@ -3165,7 +3165,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-windows-int_native-release+no_split_sections.tar.xz", + "ghc-x86_64-windows-int_native-release.tar.xz", "junit.xml" ], "reports": { @@ -3203,8 +3203,8 @@ ], "variables": { "BIGNUM_BACKEND": "native", - "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-release+no_split_sections", - "BUILD_FLAVOUR": "release+no_split_sections", + "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-release", + "BUILD_FLAVOUR": "release", "CABAL_INSTALL_VERSION": "3.8.1.0", "CONFIGURE_ARGS": "", "GHC_VERSION": "9.4.3", @@ -3212,11 +3212,11 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", - "TEST_ENV": "x86_64-windows-int_native-release+no_split_sections", + "TEST_ENV": "x86_64-windows-int_native-release", "XZ_OPT": "-9" } }, - "release-x86_64-windows-release+no_split_sections": { + "release-x86_64-windows-release": { "after_script": [ "bash .gitlab/ci.sh save_cache", "bash .gitlab/ci.sh clean" @@ -3225,7 +3225,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-windows-release+no_split_sections.tar.xz", + "ghc-x86_64-windows-release.tar.xz", "junit.xml" ], "reports": { @@ -3263,8 +3263,8 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-windows-release+no_split_sections", - "BUILD_FLAVOUR": "release+no_split_sections", + "BIN_DIST_NAME": "ghc-x86_64-windows-release", + "BUILD_FLAVOUR": "release", "CABAL_INSTALL_VERSION": "3.8.1.0", "CONFIGURE_ARGS": "", "GHC_VERSION": "9.4.3", @@ -3272,7 +3272,7 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", - "TEST_ENV": "x86_64-windows-release+no_split_sections", + "TEST_ENV": "x86_64-windows-release", "XZ_OPT": "-9" } }, ===================================== compiler/GHC/CmmToAsm/Ppr.hs ===================================== @@ -245,6 +245,10 @@ pprGNUSectionHeader config t suffix = OtherSection _ -> panic "PprBase.pprGNUSectionHeader: unknown section type" flags = case t of + Text + | OSMinGW32 <- platformOS platform + -> text ",\"xr\"" + | otherwise -> text ",\"ax\"," <> sectionType platform "progbits" CString | OSMinGW32 <- platformOS platform -> empty ===================================== rts/linker/PEi386.c ===================================== @@ -697,8 +697,16 @@ size_t getSymbolSize ( COFF_HEADER_INFO *info ) } } +// Constants which may be returned by getSymSectionNumber. +// See https://learn.microsoft.com/en-us/windows/win32/debug/pe-format#section-number-values +#define PE_SECTION_UNDEFINED ((uint32_t) 0) +#define PE_SECTION_ABSOLUTE ((uint32_t) -1) +#define PE_SECTION_DEBUG ((uint32_t) -2) + +// Returns either PE_SECTION_{UNDEFINED,ABSOLUTE,DEBUG} or the (one-based) +// section number of the given symbol. __attribute__ ((always_inline)) inline -int32_t getSymSectionNumber ( COFF_HEADER_INFO *info, COFF_symbol* sym ) +uint32_t getSymSectionNumber ( COFF_HEADER_INFO *info, COFF_symbol* sym ) { ASSERT(info); ASSERT(sym); @@ -707,7 +715,13 @@ int32_t getSymSectionNumber ( COFF_HEADER_INFO *info, COFF_symbol* sym ) case COFF_ANON_BIG_OBJ: return sym->ex.SectionNumber; default: - return sym->og.SectionNumber; + // Take care to only sign-extend reserved values; see #22941. + switch (sym->og.SectionNumber) { + case IMAGE_SYM_UNDEFINED: return PE_SECTION_UNDEFINED; + case IMAGE_SYM_ABSOLUTE : return PE_SECTION_ABSOLUTE; + case IMAGE_SYM_DEBUG: return PE_SECTION_DEBUG; + default: return (uint16_t) sym->og.SectionNumber; + } } } @@ -1652,7 +1666,7 @@ ocGetNames_PEi386 ( ObjectCode* oc ) StgWord globalBssSize = 0; for (unsigned int i=0; i < info->numberOfSymbols; i++) { COFF_symbol* sym = &oc->info->symbols[i]; - if (getSymSectionNumber (info, sym) == IMAGE_SYM_UNDEFINED + if (getSymSectionNumber (info, sym) == PE_SECTION_UNDEFINED && getSymValue (info, sym) > 0 && getSymStorageClass (info, sym) != IMAGE_SYM_CLASS_SECTION) { globalBssSize += getSymValue (info, sym); @@ -1685,21 +1699,39 @@ ocGetNames_PEi386 ( ObjectCode* oc ) for (unsigned int i = 0; i < (uint32_t)oc->n_symbols; i++) { COFF_symbol* sym = &oc->info->symbols[i]; - int32_t secNumber = getSymSectionNumber (info, sym); uint32_t symValue = getSymValue (info, sym); uint8_t symStorageClass = getSymStorageClass (info, sym); - SymbolAddr *addr = NULL; bool isWeak = false; SymbolName *sname = get_sym_name (getSymShortName (info, sym), oc); - Section *section = secNumber > 0 ? &oc->sections[secNumber-1] : NULL; + + uint32_t secNumber = getSymSectionNumber (info, sym); + Section *section; + switch (secNumber) { + case PE_SECTION_UNDEFINED: + IF_DEBUG(linker, debugBelch("symbol %s is UNDEFINED, skipping...\n", sname)); + i += getSymNumberOfAuxSymbols (info, sym); + continue; + case PE_SECTION_ABSOLUTE: + IF_DEBUG(linker, debugBelch("symbol %s is ABSOLUTE, skipping...\n", sname)); + i += getSymNumberOfAuxSymbols (info, sym); + continue; + case PE_SECTION_DEBUG: + IF_DEBUG(linker, debugBelch("symbol %s is DEBUG, skipping...\n", sname)); + i += getSymNumberOfAuxSymbols (info, sym); + continue; + default: + CHECK(secNumber < (uint32_t) oc->n_sections); + section = &oc->sections[secNumber-1]; + } SymType type; switch (getSymType(oc->info->ch_info, sym)) { case 0x00: type = SYM_TYPE_DATA; break; case 0x20: type = SYM_TYPE_CODE; break; default: - debugBelch("Invalid symbol type: 0x%x\n", getSymType(oc->info->ch_info, sym)); + debugBelch("Symbol %s has invalid type 0x%x\n", + sname, getSymType(oc->info->ch_info, sym)); return 1; } @@ -1730,8 +1762,18 @@ ocGetNames_PEi386 ( ObjectCode* oc ) CHECK(symValue == 0); COFF_symbol_aux_weak_external *aux = (COFF_symbol_aux_weak_external *) (sym+1); COFF_symbol* targetSym = &oc->info->symbols[aux->TagIndex]; - int32_t targetSecNumber = getSymSectionNumber (info, targetSym); - Section *targetSection = targetSecNumber > 0 ? &oc->sections[targetSecNumber-1] : NULL; + + uint32_t targetSecNumber = getSymSectionNumber (info, targetSym); + Section *targetSection; + switch (targetSecNumber) { + case PE_SECTION_UNDEFINED: + case PE_SECTION_ABSOLUTE: + case PE_SECTION_DEBUG: + targetSection = NULL; + break; + default: + targetSection = &oc->sections[targetSecNumber-1]; + } addr = (SymbolAddr*) ((size_t) targetSection->start + getSymValue(info, targetSym)); } else if ( secNumber == IMAGE_SYM_UNDEFINED && symValue > 0) { @@ -1976,7 +2018,19 @@ ocResolve_PEi386 ( ObjectCode* oc ) debugBelch("'\n" )); if (getSymStorageClass (info, sym) == IMAGE_SYM_CLASS_STATIC) { - Section section = oc->sections[getSymSectionNumber (info, sym)-1]; + uint32_t sect_n = getSymSectionNumber (info, sym); + switch (sect_n) { + case PE_SECTION_UNDEFINED: + case PE_SECTION_ABSOLUTE: + case PE_SECTION_DEBUG: + errorBelch(" | %" PATH_FMT ": symbol `%s' has invalid section number %02x", + oc->fileName, symbol, sect_n); + return false; + default: + break; + } + CHECK(sect_n < (uint32_t) oc->n_sections); + Section section = oc->sections[sect_n - 1]; S = ((size_t)(section.start)) + ((size_t)(getSymValue (info, sym))); } else { ===================================== rts/linker/PEi386.h ===================================== @@ -143,7 +143,7 @@ struct _Alignments { COFF_OBJ_TYPE getObjectType ( char* image, pathchar* fileName ); COFF_HEADER_INFO* getHeaderInfo ( ObjectCode* oc ); size_t getSymbolSize ( COFF_HEADER_INFO *info ); -int32_t getSymSectionNumber ( COFF_HEADER_INFO *info, COFF_symbol* sym ); +uint32_t getSymSectionNumber ( COFF_HEADER_INFO *info, COFF_symbol* sym ); uint32_t getSymValue ( COFF_HEADER_INFO *info, COFF_symbol* sym ); uint8_t getSymStorageClass ( COFF_HEADER_INFO *info, COFF_symbol* sym ); uint8_t getSymNumberOfAuxSymbols ( COFF_HEADER_INFO *info, COFF_symbol* sym ); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/855f4c9b3eda9333fb7006692fec1c7d87745c09...24f97b1fc34a9f02f1f608a0a93ec269db1813d1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/855f4c9b3eda9333fb7006692fec1c7d87745c09...24f97b1fc34a9f02f1f608a0a93ec269db1813d1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 15 03:21:52 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 14 Feb 2023 22:21:52 -0500 Subject: [Git][ghc/ghc][wip/js-rts-fixmes] 15 commits: Add clangd flag to include generated header files Message-ID: <63ec4fd0329ee_26da84bb0cd4410741f7@gitlab.mail> Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC Commits: 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 00251a83 by Josh Meredith at 2023-02-15T03:21:50+00:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 30 changed files: - .gitlab/rel_eng/upload_ghc_libs.py - compile_flags.txt - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Driver/Config/Stg/Pipeline.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/JS/Make.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Types.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Origin.hs-boot - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Fixity.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/141cba6d53b706b65bb6b583aa8b7c3a7c9ac08d...00251a836234fd2c77540a49af6acac27192686d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/141cba6d53b706b65bb6b583aa8b7c3a7c9ac08d...00251a836234fd2c77540a49af6acac27192686d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 15 03:41:39 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 14 Feb 2023 22:41:39 -0500 Subject: [Git][ghc/ghc][wip/unboxed-codebuffer] 17 commits: Add clangd flag to include generated header files Message-ID: <63ec547399eba_26da8449bc6d0107474f@gitlab.mail> Josh Meredith pushed to branch wip/unboxed-codebuffer at Glasgow Haskell Compiler / GHC Commits: 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - dc46df30 by Josh Meredith at 2023-02-15T03:41:37+00:00 CodeBuffer: change to use unboxed tuples for encoders/decoders Updates submodules for filepath and haskeline - - - - - 2bc75039 by Josh Meredith at 2023-02-15T03:41:37+00:00 Lint - - - - - 1523be1c by Josh Meredith at 2023-02-15T03:41:37+00:00 Fix build - - - - - 30 changed files: - .gitlab/rel_eng/upload_ghc_libs.py - compile_flags.txt - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Driver/Config/Stg/Pipeline.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Types.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Origin.hs-boot - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Fixity.hs - compiler/GHC/Types/ForeignCall.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/Language/Haskell/Syntax/Decls.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ed5674b42dce35ed410b4cfef66b5df25f95cc07...1523be1cc721f1ee435f0640cf910c64e91a63f7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ed5674b42dce35ed410b4cfef66b5df25f95cc07...1523be1cc721f1ee435f0640cf910c64e91a63f7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Feb 15 05:16:55 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 15 Feb 2023 00:16:55 -0500 Subject: [Git][ghc/ghc][master] docs: release notes, user guide: add js backend Message-ID: <63ec6ac71fad8_26da846201d5810858f4@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 2 changed files: - docs/users_guide/9.6.1-notes.rst - docs/users_guide/codegens.rst Changes: ===================================== docs/users_guide/9.6.1-notes.rst ===================================== @@ -132,6 +132,15 @@ Compiler presented in this GHC version as a technology preview, bugs and missing features are expected. +- The JavaScript backend has been merged. GHC is now able to be built as a + cross-compiler targeting the JavaScript platform. The backend should be + considered a technology preview. As such it is not ready for use in + production, is not distributed in the GHC release bindists and requires the + user to manually build GHC as a cross-compiler. See the JavaScript backend + `wiki `_ page + on the GHC wiki for the current status, project roadmap, build instructions + and demos. + - The :extension:`TypeInType` is now marked as deprecated. Its meaning has been included in :extension:`PolyKinds` and :extension:`DataKinds`. ===================================== docs/users_guide/codegens.rst ===================================== @@ -95,6 +95,36 @@ was built this way. If it has then the native code generator probably won't be available. You can check this information by calling ``ghc --info`` (see :ghc-flag:`--info`). +.. _javascript-code-gen: + +JavaScript Code Generator +------------------------------ + +.. index:: + single: JavaScript code generator + +This is an alternative code generator included in GHC 9.6 and above. It +generates `ECMA-262 `_ compliant JavaScript and is +included as a technical preview. At time of writing, it is being actively +developed but is not suitable for serious projects and production environments. +The JavaScript backend is not distributed in the GHC bindist and requires a +manual build. See `building the JavaScript backend +`_ page +on the GHC wiki for build instructions. + +A JavaScript cross-compiling GHC produces an executable script, and a directory +of the same name suffixed with ``.jsexe``. For example, compiling a file named +``Foo.hs`` will produce an executable script ``Foo`` and a ``Foo.jsexe`` +directory. The script is a thin wrapper that calls `Node.js +`_ on the payload of the compiled Haskell code and can +be run in the usual way, e.g., ``./Foo``, as long as ``node`` is in your +environment . The actual payload is in ``.jsexe/all.js``, for +example ``Foo.jsexe/all.js``. This file is the Haskell program cross-compiled to +JavaScript *concrete syntax* and can be wrapped in a ``